Problem with WorkSheet with multiple workSheet Change Event

Z

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

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
Solution
Fluff said:
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
Click to expand...
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"
 
Upvote 0
zubin said:
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"
Click to expand...
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
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0
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
 
Upvote 0
Have you disabled screen updating in the userform codes?
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
2
Replies
10
Views
207
Alex Blakenburg
A
E
  • Locked
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
Replies
2
Views
102
Fluff
Fluff
J
  • Solved
VBA code is not working
2
Replies
11
Views
512
smozgur
smozgur
I
  • Question Question
Userform does not show leading 0 for telephone number
Replies
1
Views
272
ipbr21054
I
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
351
tixarah
T

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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
Back
Top