Problem with WorkSheet with multiple workSheet Change Event

zubin

New Member
Joined
Sep 15, 2019
Messages
47
Hi All.....
Making some modifications in my workbook as I have ample time on hand due to lock down.
I have a worksheet change event given below.....i need to replicate the same event three times with different ranges.
Went through alot of threads but could not find one specific to my need....
Please help
VBA Code:
'Quantity input Box Column Default= "1"
Private Sub Worksheet_Change(ByVal Target As Range)
 
 
    Const SCAN_CELL As String = "C2"
    Const RANGE_BC As String = "B4:B14"
    Dim val, f As Range, rngCodes As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range(SCAN_CELL)) Is Nothing Then Exit Sub

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Me.Range(RANGE_BC)

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 3)
            .Value = .Value + 1
        End With
    Else
        Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
        f.Value = val
        
        f.Offset(0, 3).Value = 1
    End If
 Application.EnableEvents = False
    Target.Value = ""
 Application.EnableEvents = True
    Target.Select
 
 End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SCAN_CELL As String = "JC2"
    Const RANGE_BC As String = "JB4:JB14"
    Dim val, f As Range, rngCodes As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range(SCAN_CELL)) Is Nothing Then Exit Sub

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Me.Range(RANGE_BC)

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 3)
            .Value = .Value + 1
        End With
    Else
        Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
        f.Value = val
        
        f.Offset(0, 3).Value = 1
    End If
 Application.EnableEvents = False
    Target.Value = ""
 Application.EnableEvents = True
    Target.Select

 
End Sub


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
     Const SCAN_CELL As String = "KC2"
    Const RANGE_BC As String = "KB4:KB14"
    Dim val, f As Range, rngCodes As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range(SCAN_CELL)) Is Nothing Then Exit Sub

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Me.Range(RANGE_BC)

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 3)
            .Value = .Value + 1
        End With
    Else
        Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
        f.Value = val
        
        f.Offset(0, 3).Value = 1
    End If
 Application.EnableEvents = False
    Target.Value = ""
 Application.EnableEvents = True
    Target.Select
 
   End Sub

The above three code perform exactly the same function but with three different ranges.
I need to combine them in the same Worksheet change event.
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,295
Office Version
  1. 365
Platform
  1. Windows
Try this.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)


Const SCAN_CELL As String = "C2, JC2, KC2"
Dim val, f As Range, rngCodes As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range(SCAN_CELL)) Is Nothing Then Exit Sub

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Target.Offset(2, -1).Resize(11).Address

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 3)
            .Value = .Value + 1
        End With
    Else
        Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
        f.Value = val

        f.Offset(0, 3).Value = 1
    End If
    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True
    Target.Select

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,256
Office Version
  1. 365
Platform
  1. Windows
You can do it like
VBA Code:
'Quantity input Box Column Default= "1"
Private Sub Worksheet_Change(ByVal Target As Range)
 
   Dim val, f As Range, rngCodes As Range
   
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "C2" Then
      
      val = Trim(Target.Value)
      If Len(val) = 0 Then Exit Sub
      
      Set rngCodes = Me.Range("B4:B14")
      
      Set f = rngCodes.Find(val, , xlValues, xlWhole)
      If Not f Is Nothing Then
         With f.Offset(0, 3)
            .Value = .Value + 1
         End With
      Else
         Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
         f.Value = val
         f.Offset(0, 3).Value = 1
      End If
      Application.EnableEvents = False
      Target.Value = ""
      Application.EnableEvents = True
      Target.Select
   ElseIf Target.Address(0, 0) = "JC2" Then
      val = Trim(Target.Value)
      If Len(val) = 0 Then Exit Sub
      
      Set rngCodes = Me.Range("JB4:JB14")
      
      Set f = rngCodes.Find(val, , xlValues, xlWhole)
      If Not f Is Nothing Then
         With f.Offset(0, 3)
            .Value = .Value + 1
         End With
      Else
         Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
         f.Value = val
         
         f.Offset(0, 3).Value = 1
      End If
      Application.EnableEvents = False
      Target.Value = ""
      Application.EnableEvents = True
      Target.Select
   End If
 End Sub
 
Solution

zubin

New Member
Joined
Sep 15, 2019
Messages
47
You can do it like
VBA Code:
'Quantity input Box Column Default= "1"
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim val, f As Range, rngCodes As Range
  
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "C2" Then
     
      val = Trim(Target.Value)
      If Len(val) = 0 Then Exit Sub
     
      Set rngCodes = Me.Range("B4:B14")
     
      Set f = rngCodes.Find(val, , xlValues, xlWhole)
      If Not f Is Nothing Then
         With f.Offset(0, 3)
            .Value = .Value + 1
         End With
      Else
         Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
         f.Value = val
         f.Offset(0, 3).Value = 1
      End If
      Application.EnableEvents = False
      Target.Value = ""
      Application.EnableEvents = True
      Target.Select
   ElseIf Target.Address(0, 0) = "JC2" Then
      val = Trim(Target.Value)
      If Len(val) = 0 Then Exit Sub
     
      Set rngCodes = Me.Range("JB4:JB14")
     
      Set f = rngCodes.Find(val, , xlValues, xlWhole)
      If Not f Is Nothing Then
         With f.Offset(0, 3)
            .Value = .Value + 1
         End With
      Else
         Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
         f.Value = val
        
         f.Offset(0, 3).Value = 1
      End If
      Application.EnableEvents = False
      Target.Value = ""
      Application.EnableEvents = True
      Target.Select
   End If
End Sub
Hi Fluff.......Thanks for the quick reply....
Your code is working perfect for two ranges "B4:F17" and "JB4:JF17" Please add the third range....... that is "KB4:KF17"
 

zubin

New Member
Joined
Sep 15, 2019
Messages
47

ADVERTISEMENT

Hi Fluff.......Thanks for the quick reply....
Your code is working perfect for two ranges "B4:F17" and "JB4:JF17" Please add the third range....... that is "KB4:KF17"
Sorry For the inconvenience Fluff.........But Thanks a ton.......I worked up the third range .......all three ranges are working perfect...
Once again Thanks a lot
and have a nice day
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,256
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

zubin

New Member
Joined
Sep 15, 2019
Messages
47

ADVERTISEMENT

Since all is fine now.......can i ask a query regarding the same topic..
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,256
Office Version
  1. 365
Platform
  1. Windows

zubin

New Member
Joined
Sep 15, 2019
Messages
47
Originally all the three ranges were in three different Sheets with three different userforms and each range had a separate worksheet change event in their respective worksheet. Technically everything worked fine, except one problem....which i'll describe later. All three userforms had a 3 command button (Beside other textboxes and other command buttons) so that I could navigate between the userforms. Now the problem was that everytime i navigate between these userforms there is a short spell of time in which the worksheet becomes visible for a fraction of a second before the other userform opens which i found irritating. I thought it might be due to activation of worksheets corresponding to the userform that was creating this problem.
That is the reason i put all the ranges in on worksheet......But the same problem persists
Functionally everything works fine......its just the irritation factor.....is there a solution...
If you need any other information please let me know..
Thanks Fluff
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,256
Office Version
  1. 365
Platform
  1. Windows
Have you disabled screen updating in the userform codes?
 

Watch MrExcel Video

Forum statistics

Threads
1,132,981
Messages
5,656,214
Members
418,290
Latest member
ArrArkRE

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top