Looping Procedure In VBA Code

excelbytes

excelbytes

Active Member
Joined
Dec 11, 2014
Messages
288
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.
 
Sort by date Sort by votes
Joe4 said:
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).
Click to expand...
If you look at the very top of this post, I had

VBA Code: 
    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
        
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If

What I am trying to do with this:

VBA Code: 
Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)

Is to look up in either the HYUNDAI worksheet Range P2:R107 or in the KIA worksheet Range P2:R75 the full description in the drop down list and return the code from column 2 in those ranges.
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
excelbytes said:
If you look at the very top of this post, I had

VBA Code: 
    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
       
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If

What I am trying to do with this:

VBA Code: 
Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)

Is to look up in either the HYUNDAI worksheet Range P2:R107 or in the KIA worksheet Range P2:R75 the full description in the drop down list and return the code from column 2 in those ranges.
Click to expand...
Joe4,

I have used Mr Excel Forum many times with excellent results, but this issue is a bit more complex than ones I had in the past, and unfortunately, I am not as well versed in VBA as I would like. I don't know, but is there any way we can connect by phone to expedite this process since I am probably not clearly expressing my needs as completely as necessary.
 
Upvote 0
excelbytes said:
If you look at the very top of this post, I had

VBA Code: 
    If Not Intersect(Target, Range("H15:H50")) Is Nothing Then
       
      If Len(Trim(Target.Value)) = 0 Then
        Exit Sub
      End If

What I am trying to do with this:

VBA Code: 
Target.Value = Application.VLookup(Target.Value, rngLookup, 2, False)

Is to look up in either the HYUNDAI worksheet Range P2:R107 or in the KIA worksheet Range P2:R75 the full description in the drop down list and return the code from column 2 in those ranges.
Click to expand...
That section of your code only updates column H IF you make a change directly to column H.
I thought the section of code you are asking about here is watching for changes to column B (not column H), and then updating column H.
So I think you may be confusing your different parts of your code.

excelbytes said:
I have used Mr Excel Forum many times with excellent results, but this issue is a bit more complex than ones I had in the past, and unfortunately, I am not as well versed in VBA as I would like. I don't know, but is there any way we can connect by phone to expedite this process since I am probably not clearly expressing my needs as completely as necessary.
Click to expand...
That is not really something we offer, unless you want to pay for Consulting Services, which MrExcel does have (see here: Consulting Services).
I myself do not do Consulting work.

I think you may have some confusion/overlapping between your different sections of code.
I think we may need to consider all these rules in relation to each other.

Can you explain, in detail, in plain English, exactly what you want each section of code to do?
Be sure to elaborate which cells you are watching for updates, and what cells those changes should automatically change.

If the coding tips I gave you did not help you, and you need further help writing the code, quite frankly I would prefer to rewrite all the code myself, instead of trying to edit someone else's code. I may borrow some things that you already have there, but will probably make changes to it, based on those details.
 
Upvote 0
If you feel it best to rewrite the code, I'm fine with that, I have no pride of authorship, I just need it to work. Thank you. Unfortunately, the file has some proprietary information so I can't send copies of it, but will try to explain it the best I can.

This involves three worksheets:

"OFFICIAL DRAFT" - this is where in cells B15:B50 the user can choose either an "H" or "K" in any of the cells in that range. So over the 36 cells, any number can be an "H" and any number can be a "K" at the same time. B15 = H, B16 = K, B17 = K, B18 = H, ETC.

Based on that selection, in column H for that corresponding row, there is a data validation drop down list. If an "H" is selected, it refers to the "HYUNDAI" worksheet. If a "K" is selected, it refers to the "KIA" worksheet.

"HYUNDAI" - on this worksheet, in cells P2:R107, is a data set. Column P has the full code and description (e.g. AB Cattle Prod). Column Q has just the code (e.g. AB) and column R has the description (e.g. Cattle Prod). When and "H" is selected in any cell in column B of the OFFICIAL DRAFT worksheet, the corresponding cell in that row in column H should have a drop down list showing the full code and description from column P. When a selection is made from that list of full code and description, the result should show only the code. That is why the Vlookup is incorporated into the code. User chooses the full code and description from column 1 of the range P2:R107, and the code returns the code only from column 2 (Q).

"KIA" - the same concept is here as was in the HYUNDAI explanation, except the range here is P2:R75.

So a user enters an "H" in cell B15, goes over to cell H15, clicks the drop down arrow and is presented with the list from column P of the HYUNDAI P2:R107. Chooses one of the full code and description selections, and the result is only the code is now in cell H15. Then they choose a "K" in cell B16 and in cell H16 the list from the "KIA" worksheet column P of the range P2:R75 is shown. They select a full code and description and the result, using the Vlookup, is just the two digit code.

I hope I explained it as clearly as necessary. Unfortunately, I will be out of the office for most of the day, but will check emails on my phone and try to respond as best I can. If you can provide an update to the code or newly rewritten code, I will be able to test it this evening.

Thank you so much for your effort and help with this!
 
Upvote 0
OK, it will take me some time to try to recreate your scenario so I can code and test it.

If you are able to remove any proprietary info, and post a simplified version of it on a file sharing site and post a link to it, that would save me a bit of time in trying to build what you already have.
 
Upvote 0
Joe4 said:
OK, it will take me some time to try to recreate your scenario so I can code and test it.

If you are able to remove any proprietary info, and post a simplified version of it on a file sharing site and post a link to it, that would save me a bit of time in trying to build what you already have.
Click to expand...
I'll try to put something together this evening
 
Upvote 0
OK, I think I was able to recreate it and see what you are trying to do now.
See if this works for you:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, rng2 As Range
    Dim cell As Range
    Dim rngV As String
    Dim rngL As Range
        
'***PART 1: Add Data Validation to column K when column B is updated
'   See if any updates made to B15:B50
    Set rng1 = Intersect(Target, Range("B15:B50"))
    If Not rng1 Is Nothing Then
'       Loop through updated cells in column B
        For Each cell In rng1
'           Check value of column B
            Select Case cell.Value
                Case "H"
'                   Set range to Hyundai sheet
                    rngV = "=HYUNDAI!$P$2:$P$107"
                Case "K"
'                   Set range to KIA sheet
                    rngV = "=KIA!$P$2:$P$107"
                Case Else
                    rngV = ""
            End Select
            
'           Clear value in cell K
            Application.EnableEvents = False
            Cells(cell.Row, "K").ClearContents
            Application.EnableEvents = True
'           Add Data Validation in H or K selected
            If rngV <> "" Then
'               Apply Data Validation to column K of same row
                With Cells(cell.Row, "K").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=rngV
                End With
            End If
        Next cell
    End If

'***PART 2: Lookup value from table when column K id updated
'   See if any updates made to K15:K50
    Set rng2 = Intersect(Target, Range("K15:K50"))
    If Not rng2 Is Nothing Then
'       Loop through updated cells in column K
        For Each cell In rng2
'           Check value of column B
            Select Case cell.Offset(0, -9).Value
                Case "H"
'                   Set range to Hyundai sheet
                    Set rngL = Sheets("HYUNDAI").Range("P2:R107")
                Case "K"
'                   Set range to KIA sheet
                    Set rngL = Sheets("KIA").Range("P2:R107")
                Case Else
                    MsgBox "Invalid value in column B", vbOKOnly, "ERROR!"
                    Exit Sub
            End Select
'           Lookup value from 2nd column of lookup table
            Application.EnableEvents = False
            cell.Value = Application.VLookup(cell.Value, rngL, 2, False)
            Application.EnableEvents = True
        Next cell
    End If

End Sub
 
Upvote 0
Joe4 said:
OK, I think I was able to recreate it and see what you are trying to do now.
See if this works for you:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, rng2 As Range
    Dim cell As Range
    Dim rngV As String
    Dim rngL As Range
       
'***PART 1: Add Data Validation to column K when column B is updated
'   See if any updates made to B15:B50
    Set rng1 = Intersect(Target, Range("B15:B50"))
    If Not rng1 Is Nothing Then
'       Loop through updated cells in column B
        For Each cell In rng1
'           Check value of column B
            Select Case cell.Value
                Case "H"
'                   Set range to Hyundai sheet
                    rngV = "=HYUNDAI!$P$2:$P$107"
                Case "K"
'                   Set range to KIA sheet
                    rngV = "=KIA!$P$2:$P$107"
                Case Else
                    rngV = ""
            End Select
           
'           Clear value in cell K
            Application.EnableEvents = False
            Cells(cell.Row, "K").ClearContents
            Application.EnableEvents = True
'           Add Data Validation in H or K selected
            If rngV <> "" Then
'               Apply Data Validation to column K of same row
                With Cells(cell.Row, "K").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=rngV
                End With
            End If
        Next cell
    End If

'***PART 2: Lookup value from table when column K id updated
'   See if any updates made to K15:K50
    Set rng2 = Intersect(Target, Range("K15:K50"))
    If Not rng2 Is Nothing Then
'       Loop through updated cells in column K
        For Each cell In rng2
'           Check value of column B
            Select Case cell.Offset(0, -9).Value
                Case "H"
'                   Set range to Hyundai sheet
                    Set rngL = Sheets("HYUNDAI").Range("P2:R107")
                Case "K"
'                   Set range to KIA sheet
                    Set rngL = Sheets("KIA").Range("P2:R107")
                Case Else
                    MsgBox "Invalid value in column B", vbOKOnly, "ERROR!"
                    Exit Sub
            End Select
'           Lookup value from 2nd column of lookup table
            Application.EnableEvents = False
            cell.Value = Application.VLookup(cell.Value, rngL, 2, False)
            Application.EnableEvents = True
        Next cell
    End If

End Sub
Click to expand...
Thanks! I'll let you know later this evening.
 
Upvote 0
excelbytes said:
Thanks! I'll let you know later this evening.
Click to expand...
There are no errors appearing an it allows me to select an H or K or mix in column B, but it is pulling in the full code and description, somehow not applying the Vlookup function. I've created a sample file for your use. I have Xl2bb, but how do I send a file with multiple worksheets? Or can I e-mail it to you?
 
Upvote 0
excelbytes said:
There are no errors appearing an it allows me to select an H or K or mix in column B, but it is pulling in the full code and description, somehow not applying the Vlookup function. I've created a sample file for your use. I have Xl2bb, but how do I send a file with multiple worksheets? Or can I e-mail it to you?
Click to expand...
Upload the file to a file sharing site, and provide a link to it in this thread. I will look at it later tonight when I am at a computer where I can download files.
 
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
325
HighAndWilder
H
M
  • Question Question
Trying to apply 2 Worksheet Changes
Replies
1
Views
110
Joe4
Joe4
J
  • Solved
VBA code is not working
2
Replies
11
Views
437
smozgur
smozgur
SaraWitch
  • Solved
Run Multiple Private Sub Worksheet_Change(ByVal Target As Range)
Replies
5
Views
659
Joe4
Joe4
J
  • Solved
VBA to search or autofilter
Replies
2
Views
326
Jagat Pavasia
J

Forum statistics

Threads
1,222,764
Messages
6,168,088
Members
452,162
Latest member
strail1972

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