Altering multiple sheets with data validation

 

Let's say I have a column of DropDown lists, can I make so that the VBA code applies to the entire column? 

Hello again Michael,

Yes! My previous post was very basic but it can be applied to multiple cells on the worksheet. However, a few comments as follows.

1. The code now tests for only one cell change at a time. This means if you select multiple cells and delete the contents then that action will be ignored by the code. However, if you select a single validation cell and delete the contents then the alternative sheet will be updated likewise.
2. Not essential but I have included a UDF to test if the cell contains List Type Validation otherwise any cell that is changed in the column will be copied to the same cell address in the alternate sheet.
3. See the comment where I assign the column to a range variable and you will need to edit the column id.

All of the code below can go in ThisWorkbook module.

See the Sub EnablingEvents(). If for any reason during development the events are turned off due to an error that actually stops the code then the event will not fire again until events are turned back on. I always include this sub during development because it is so easy to just click in the sub and press F5 to re-enable the events.

As per my previous post, feel free to get back to me if anything not working as it should or you don't understand something.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim rngValidation As Range

    Dim strTargAddr As String

    Dim wsAlternate As Worksheet

    On Error GoTo ReEnableEvents        'Ensures that events are re-enabled if a code error occurs

    Application.EnableEvents = False    'Suppress recursive calls when the second sheet is updated

    'Next line: Code only handles single cell change otherwise suppress processing

    If Target.Cells.Count <> 1 Then GoTo ReEnableEvents

    'Next line: If cell does not contain List Type Validation then suppress processing

    If HasListValidation(Target) = False Then GoTo ReEnableEvents

        With Sh

            'Following assigns the range from cell B2 to bottom of worksheet to the rngValidation variable

           'Edit the two instances of "B" in the following line to your column id.

            Set rngValidation = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B"))

        End With

        'Next line: Not Nothing then is Something so Target is in the rngValidation range

        If Not Intersect(Target, rngValidation) Is Nothing Then

            Select Case Sh.Name

                Case "Sheet1"  'Edit "Sheet1" to your sheet name

                    Set wsAlternate = Worksheets("Sheet2")

                Case "Sheet2"  'Edit "Sheet2" to your sheet name

                    Set wsAlternate = Worksheets("Sheet1")

                Case Else

                    GoTo ReEnableEvents

            End Select

            strTargAddr = Target.Address

            wsAlternate.Range(strTargAddr).Value = Target.Value

        End If

ReEnableEvents:

    If Err.Number <> 0 Then

        MsgBox "Error occurred in module ThisWorkbook, Private Sub Workbook_SheetChange"

    End If

    Application.EnableEvents = True

    On Error GoTo 0     'Cancel the On Error

End Sub

Function HasListValidation(rngCel As Range) As Boolean

    'This function tests for List Type validation in the Target cell

    Dim lngValType As Long

    On Error Resume Next    'If no validation then next line errors

    lngValType = rngCel.Validation.Type

    On Error GoTo 0

    If lngValType = 3 Then      '3 is List Type Validation

        HasListValidation = True

    Else

        HasListValidation = False

    End If

End Function

Sub EnablingEvents()

    'If for any reason Events are disabled during testing etc

    'Then click anywhere in this sub and press F5

    Application.EnableEvents = True

End Sub

First, thank you so much for replying. 

Yes, DropDown list on sheet 1 and sheet 2 are thr same. I'm trying to do what you asked in #2. They need to match. 

I did make it so that they are in the same cells on both sheets hoping it would be easier to make this work. VBA macro is always welcomed! 

Thanks again :)

Michael

Wow! It worked! That's amazing. Thank you so much. You are incredible! 

May I ask one more question regarding Select Case? Let's say I have a column of DropDown lists, can I make so that the VBA code applies to the entire column? 

Again, you are awesome, thank you,

Michael

Hello Michael,

The code below is a very simple example for just one Validation DropDown on each sheet and both at the same cell address on the sheets.

I have used Select Case so that it is easy to edit the code if it needs to apply to additional sheets.

Could expand the code to also include additional Select Case if multiple DropDown Lists are on each sheet and they are to be copied to their respective twin on other sheets.

In the VBA Editor, Double click ThisWorkbook module in the Project Explorer window. (If Project Explorer is not displayed then Press Ctrl and R to display it.)

Copy the code below and paste into ThisWorkbook module and save the workbook as Macro Enabled. If you require more help with installing the macro or to expand the macro to cover additional DropDowns etc then feel free to get back to me.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim strTargAddr As String

    Dim wsAlternate As Worksheet

    On Error GoTo ReEnableEvents        'Ensures that events are re-enabled if a code error occurs

    Application.EnableEvents = False    'Suppress recursive calls when the second sheet is updated

    Select Case Sh.Name

        Case "Sheet1"   'Edit "Sheet1" to your sheet name

            Set wsAlternate = Worksheets("Sheet2")

        Case "Sheet2"   'Edit "Sheet2" to your sheet name

            Set wsAlternate = Worksheets("Sheet1")

        Case Else

            GoTo ReEnableEvents

    End Select

    If Target.Address = "$B$2" Then

        strTargAddr = Target.Address

        wsAlternate.Range(strTargAddr).Value = Target.Value

    End If

ReEnableEvents:

    If Err.Number <> 0 Then

        MsgBox "Error occurred in module ThisWorkbook, Private Sub Workbook_SheetChange"

    End If

    Application.EnableEvents = True

    On Error GoTo 0     'Cancel the On Error

End Sub