简体   繁体   中英

Excel VBA combining Worksheet_Change codes for 2 target addresses

I am new to VBA and was wondering how I combine 2 worksheet_change scripts, or if there is something else I should use.

I have a dropdown list which when selected give dependancy to another dropdown list.

For the first dropdown I have code which filters the columns so the other columns are hidden. There are several columns which have the same text in row 3 making multiple columns associated with the first dropdown. The code below works fine for B2.

Users may stop at the first dropdown, but if they then select the second dropdown I need the spreadsheet to filter the columns further so only one column is displayed. The heading titles are in row 4.

At the moment I have:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$2" Then
Dim the_selection As String
Dim the_group As String
the_selection = Sheet1.Range("B2")
    Dim Rep as Integer
    For Rep = 5 to 100
        the_column = GetColumnLetter_ByInteger(Rep)
        the_group = Sheet1.Range(the_column & "3")
            If the_selection = the_group Then
            Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
            Else
              Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
            End If
     Next Rep
End If

End Sub

If I try and create a Worksheet_SelectionChange for the C2 dropdown it sort of works but I have to click out of the cell and then in again for it to filter properly. This is not ideal. Is there a way of incorporating the codes together in the Worksheet_change.

Additionally, is it possible for the second selection to also filter the rows so only those with values appear and the blank ones are hidden? The second filter would always filter to one column and never more than one. What code would I add to reset the row filter when a user selected another dropdown?

Any help is appreciated.

Lando :)

Your original code could be rewritten as

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim the_selection As String
    Dim the_group As String
    Dim Rep As Long

    If Target.Address = "$B$2" Then
        the_selection = Sheet1.Range("B2") 'If this code is in Sheet1 you can just use "the_selection=Target".
        For Rep = 5 To 100
            the_group = Sheet1.Cells(3, Rep)
            Sheet1.Columns(Rep).Hidden = (the_selection <> the_group)
        Next Rep
    End If

End Sub  
  • Sheet1.Columns(Rep).Hidden requires TRUE or FALSE to hide/show the column.
  • (the_selection <> the_group) will return TRUE if the_selection is different from the_group and FALSE if not.

Your combined code could be:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim the_selection As String
    Dim the_group As String
    Dim Rep As Long

    If Not Intersect(Target, Range("B2:C2")) Is Nothing Then
        the_selection = Target

        'Unhide all columns if B2 is changed.
        If Target.Address = "$B$2" Then
            Sheet1.Columns.Hidden = False
        End If

        For Rep = 5 To 100
            the_group = Sheet1.Cells(Target.Column + 1, Rep)
            Select Case Target.Address
                Case "$B$2"
                    Sheet1.Columns(Rep).Hidden = (the_selection <> the_group)
                Case "$C$2"
                    If Not Sheet1.Columns(Rep).Hidden Then
                        Sheet1.Columns(Rep).Hidden = (the_selection <> the_group)
                    End If
            End Select
        Next Rep
    End If

End Sub  
  • The code will take the value from B2 or C2 ( the_selection=Target ).
  • B2 looks at row 3, C2 looks at row 4 - column B is also column 2, column C is also column 3 so the code just adds one to get the correct row number ( the_group = Sheet1.Cells(Target.Column + 1, Rep) ).
  • If the value being changed is C2 then you don't want to unhide any columns already hidden by B2 so the code checks if the column is not already hidden before attempting to hide it ( If Not Sheet1.Columns(Rep).Hidden Then )

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM