简体   繁体   中英

How to use Multiple Private Sub Worksheet_Change(ByVal Target As Range) in one sheet

Hi team, please anybody can help me, When I am using this code in my sheet

Option Explicit

Private Sub ComboBox1_GotFocus()
ComboBox1.ListFillRange = "DropDownList"
Me.ComboBox1.DropDown
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If
End Sub

**It is work perfectly, I don't get any error or messages,

and when I am using this code separately in my sheet**

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCell As Range, m, v
    Dim rngCell1 As Range, m1, v1
    
Check1:

    If Application.Intersect(Target, Range("B19:B38")) Is Nothing Then GoTo Check2:
    
    For Each rngCell In Range("B19:B38")
        v = rngCell.Value
        If Len(v) > 0 Then

            'See if the value is in your lookup table
            m = Application.VLookup(v, _
                 ThisWorkbook.Sheets("ItemName").Range("D2:E1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m) Then rngCell.Value = m
End If
    Next
Exit Sub

Check2:

    If Application.Intersect(Target, Range("A6,D6")) Is Nothing Then Exit Sub

    For Each rngCell1 In Range("A6,D6")
        v1 = rngCell1.Value
        If Len(v1) > 0 Then

            'See if the value is in your lookup table
            m1 = Application.VLookup(v1, _
                 ThisWorkbook.Sheets("PARTY LEDGER").Range("B2:C1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m1) Then rngCell1.Value = m1

        End If
        Next


      On Error GoTo Hell
If Target.Address(False, False) = "A6" And Target.Validation.Type = 3 Then
    Range("B14:B23").Value = ""
End If
Hell:

End Sub

** it is also work perfectly. I never face any problems or error. but when I am using both code in my sheet, it give me an error, because of two

Private Sub Worksheet_Change(ByVal Target As Range)

how to merge these code into one. please help me. **

This is because you can't use the same Sub name twice. You can, however, copy the content of one in front of the content of the other Sub. Then they get executed after eachother.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error Resume Next
  If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
    Sheet12.[F5] = ActiveCell.Row
  End If
  On Error Goto 0

    Dim rngCell As Range, m, v
    Dim rngCell1 As Range, m1, v1
    
Check1:

    If Application.Intersect(Target, Range("B19:B38")) Is Nothing Then GoTo Check2:
    
    For Each rngCell In Range("B19:B38")
        v = rngCell.Value
        If Len(v) > 0 Then

            'See if the value is in your lookup table
            m = Application.VLookup(v, _
                 ThisWorkbook.Sheets("ItemName").Range("D2:E1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m) Then rngCell.Value = m
  End If
    Next
  Exit Sub

Check2:

    If Application.Intersect(Target, Range("A6,D6")) Is Nothing Then Exit Sub

    For Each rngCell1 In Range("A6,D6")
        v1 = rngCell1.Value
        If Len(v1) > 0 Then

            'See if the value is in your lookup table
            m1 = Application.VLookup(v1, _
                 ThisWorkbook.Sheets("PARTY LEDGER").Range("B2:C1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m1) Then rngCell1.Value = m1

        End If
        Next


      On Error GoTo Hell
  If Target.Address(False, False) = "A6" And Target.Validation.Type = 3 Then
    Range("B14:B23").Value = ""
  End If
Hell:


End Sub

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