Looping Procedure In VBA Code

excelbytes

excelbytes

Active Member
Joined
Dec 11, 2014
Messages
291
Office Version
  1. 365
Platform
  1. Windows
I have several procedures in the Worksheet_Change procedure. The first three work fine. The last one highlighted in red at the end below is where I have an issue. I think I need to implement a looping procedure but don't know how to do that properly. What I want to occur is as follows:

Cells B15:B50 can have either an "H" or "K" in it. Any number of these cells can have either. So cell B15 can be "K", B16 can be "H", B17 can be "H", B18 can be "K", etc.

If an "H" is in any of the cells in B15:B50, the corresponding cell in column H needs to have a drop down list based on this:

VBA Code: 
      Set rngLookup = Worksheets("HYUNDAI").Range("P2:R107")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

If a "K" is in any of the cells in B15:B50, the corresponding cell in column H needs to have a drop down list based on this:

VBA Code: 
      Set rngLookup = Worksheets("KIA").Range("P2:R75")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

So H15 could have a different drop down list than H16, than H17, etc.

Here is the complete code:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngLookup As Range

    If Not Intersect(Target, Range("L15:L50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("FORM DETAILS").Range("E4:G25")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

    End If


    If Not Intersect(Target, Range("P15:P50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("FORM DETAILS").Range("H4:J5")

      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

    End If


    If Not Intersect(Target, Range("M15:M50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("FORM DETAILS").Range("B4:D13")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

    End If
    
[B][COLOR=rgb(184, 49, 47)]    If Worksheets("OFFICIAL DRAFT").Range("B15:B50") = "K" Then[/COLOR][/B]
[COLOR=rgb(184, 49, 47)][B]
    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("KIA").Range("P2:R75")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True
    End If
    
    Else
    
    If Worksheets("OFFICIAL DRAFT").Range("B15:B50") = "H" Then
    
    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("HYUNDAI").Range("P2:R107")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True
    End If
    End If
    End If
    [/B][/COLOR]
[B][COLOR=rgb(184, 49, 47)]End Sub[/COLOR][/B]

Currently I get a "type mismatch" error 13 when I enter anything in those cells.

I hope this is clear enough.

Thanks in advance for your help.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Yes, this is not a valid line of code:
VBA Code: 
If Worksheets("OFFICIAL DRAFT").Range("B15:B50") = "K" Then
You are literally asking does the range B15:B50 equal "K". That does not make sense. You cannot compare a whole range of cells to a single value in that manner.

If you want to check to see if ANY cells in that range have a "K" in them, try this:
VBA Code: 
Dim rng as Range
Set rng = Worksheets("OFFICIAL DRAFT").Range("B15:B50")
If Application.WorksheetFunction.CountIf(rng, "K") > 0 Then
 
Upvote 0
Joe4 said:
Yes, this is not a valid line of code:
VBA Code: 
If Worksheets("OFFICIAL DRAFT").Range("B15:B50") = "K" Then
You are literally asking does the range B15:B50 equal "K". That does not make sense. You cannot compare a whole range of cells to a single value in that manner.

If you want to check to see if ANY cells in that range have a "K" in them, try this:
VBA Code: 
Dim rng as Range
Set rng = Worksheets("OFFICIAL DRAFT").Range("B15:B50")
If Application.WorksheetFunction.CountIf(rng, "K") > 0 Then
Click to expand...
So close!!!

Here is what I get if I start the selections choosing an "H" first. The first "H" works, then all the "Ks" work, but no more of the "Hs" work:

Screenshot 2024-09-26 142852.png


Here is what I get if I start the selections choosing a "K" first. None of the "Hs" work:

Screenshot 2024-09-26 143204.png


Here is the modified code as you suggested:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngLookup As Range
Dim rng As Range
Set rng = Worksheets("OFFICIAL DRAFT").Range("B15:B50")


    If Not Intersect(Target, Range("L15:L50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("FORM DETAILS").Range("E4:G25")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

    End If


    If Not Intersect(Target, Range("P15:P50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("FORM DETAILS").Range("H4:J5")

      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

    End If


    If Not Intersect(Target, Range("M15:M50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("FORM DETAILS").Range("B4:D13")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

    End If
    
    If Application.WorksheetFunction.CountIf(rng, "K") > 0 Then

    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("KIA").Range("P2:R75")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True
    End If
    
    Else
    
    If Application.WorksheetFunction.CountIf(rng, "H") > 0 Then
    
    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If
      
      Set rngLookup = Worksheets("HYUNDAI").Range("P2:R107")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True
    End If
    End If
    End If
    
End Sub

Any suggestions?
 
Upvote 0
I did not analyze your entire code - I was just commenting on the error you had in that one line, and showed you how to update that one line to get rid of that error.

Can we focus in on this last section, and can you describe to me exactly what should happen and when?
Do you only want that part of the code to run when a cell in B15:B50 is manually being updated?
 
Upvote 0
Joe4 said:
I did not analyze your entire code - I was just commenting on the error you had in that one line, and showed you how to update that one line to get rid of that error.

Can we focus in on this last section, and can you describe to me exactly what should happen and when?
Do you only want that part of the code to run when a cell in B15:B50 is manually being updated?
Click to expand...
I have several procedures in the Worksheet_Change procedure. The first three work fine. The last one at the end is where I have an issue. What I want to occur is as follows:

Cells B15:B50 can have either an "H" or "K" in it. Any number of these cells can have either. So cell B15 can be "K", B16 can be "H", B17 can be "H", B18 can be "K", etc.

If an "H" is in any of the cells in B15:B50, the corresponding cell in column H needs to have a drop down list based on this:

VBA Code: 
      Set rngLookup = Worksheets("HYUNDAI").Range("P2:R107")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

If a "K" is in any of the cells in B15:B50, the corresponding cell in column H needs to have a drop down list based on this:

VBA Code: 
      Set rngLookup = Worksheets("KIA").Range("P2:R75")
  
      Application.EnableEvents = False
      
      Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
    
      Application.EnableEvents = True

So H15 could have a different drop down list than H16, than H17, etc.

There are two different drop down lists and I want a different list presented to the user in column "H" depending if they choose an H or K in column "B". And each line could be either an H or K. The VLookup aspect is so when they choose an item from the list, only the first 2 digits of that item (the code) appears in column "H".
 
Upvote 0
OK, I assume that you are familiar with how Worksheet_Change event procedures are triggered, right?
They run when a cell on your sheet is manually updated. You typically check to see if the cell being updated is in a particular range, and if it is, you perform some actions.

So, in this case, you appear to be watching for an update in column B, specifically between cells B15:B50. Right?
When that happens, do you only need to check the contents of that row that was just updated, or are you checking EVERY single row any time any change is made to every row?

For example, if cell B24 was just updating, do you need your code to just check and perform actions on row 24, or do you need it to check rows 15:50 every time (even though these other rows were NOT the ones that were just updated, triggering the code to be run?
 
Upvote 0
Joe4 said:
OK, I assume that you are familiar with how Worksheet_Change event procedures are triggered, right?
They run when a cell on your sheet is manually updated. You typically check to see if the cell being updated is in a particular range, and if it is, you perform some actions.

So, in this case, you appear to be watching for an update in column B, specifically between cells B15:B50. Right?
When that happens, do you only need to check the contents of that row that was just updated, or are you checking EVERY single row any time any change is made to every row?

For example, if cell B24 was just updating, do you need your code to just check and perform actions on row 24, or do you need it to check rows 15:50 every time (even though these other rows were NOT the ones that were just updated, triggering the code to be run?
Click to expand...
Only the contents of that row.
 
Upvote 0
So, if I am understanding you correctly, I think that block of code should be structured something like this:
VBA Code: 
'   Watch for changes to column B
    Dim cell As Range
    
    If Not Intersect(Target, Range("B15:B50")) Is Nothing Then
        For Each cell In Intersect(Target, Range("B15:B50"))
            Select Case cell.Value
                Case "H"
                    'Do this if the value is H
                    'you can get the row number of the change with "cell.Row"
                Case "K"
                    'Do this if the value is K
                    'you can get the row number of the change with "cell.Row"
            End Select
        Next cell
    End If
Note that the two sections with comments "'Do this if the value is H" and "'Do this if the value is K" is where you would put the code for the drop-down list.
To update column H in that row, you can reference that cell like this:
Excel Formula: 
Range("H" & cell.Row)
 
Upvote 0
Joe4 said:
So, if I am understanding you correctly, I think that block of code should be structured something like this:
VBA Code: 
'   Watch for changes to column B
    Dim cell As Range
   
    If Not Intersect(Target, Range("B15:B50")) Is Nothing Then
        For Each cell In Intersect(Target, Range("B15:B50"))
            Select Case cell.Value
                Case "H"
                    'Do this if the value is H
                    'you can get the row number of the change with "cell.Row"
                Case "K"
                    'Do this if the value is K
                    'you can get the row number of the change with "cell.Row"
            End Select
        Next cell
    End If
Note that the two sections with comments "'Do this if the value is H" and "'Do this if the value is K" is where you would put the code for the drop-down list.
To update column H in that row, you can reference that cell like this:
Excel Formula: 
Range("H" & cell.Row)
Click to expand...
Here is the code currently:

VBA Code: 
    If Not Intersect(Target, Range("B15:B50")) Is Nothing Then
    
        For Each cell In Intersect(Target, Range("B15:B50"))
        
            Select Case cell.Value
        
           Case "K"
      
                Set rngLookup = Worksheets("KIA").Range("P2:R75")
            
                Application.EnableEvents = False
                
                Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
              
                Application.EnableEvents = True
 
      Case "H"
      
                Set rngLookup = Worksheets("HYUNDAI").Range("P2:R107")
            
                Application.EnableEvents = False
                
                Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)
              
                Application.EnableEvents = True
                
                 End Select
        Next cell
      
    End If

It is pulling the correct drop down list into column H, so that's great!

However, it's not running the Vlookup and pulling the two digit code but rather the entire description. I'm guessing it has something to do with your comment about "Range("H" & cell.Row)", but I'm not sure how to enter that into the code. Can you show me?
 
Upvote 0
There is nothing in that block of code that would update column H, only column B.

What exactly are you trying to do with this line here?
VBA Code: 
Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)

Firstly, you should use "cell" instead of "Target", as "Target" could actually be a multi-cell range (which is why we have the For loop).
 
Upvote 0
You must log in or register to reply here.

Similar threads

excelbytes
  • Solved
Data Validation Show Codes Only
2 3
Replies
20
Views
374
HighAndWilder
H
M
  • Solved
Trying to apply 2 Worksheet Changes
Replies
1
Views
163
Joe4
Joe4
J
  • Solved
VBA code is not working
2
Replies
11
Views
458
smozgur
smozgur
SaraWitch
  • Solved
Run Multiple Private Sub Worksheet_Change(ByVal Target As Range)
Replies
5
Views
761
Joe4
Joe4
J
  • Solved
VBA to search or autofilter
Replies
2
Views
369
Jagat Pavasia
J

Forum statistics

Threads
1,223,875
Messages
6,175,117
Members
452,613
Latest member
amorehouse

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