Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

If and Vlookup in VBA 1

Status
Not open for further replies.

chriscusick

Technical User
Apr 23, 2013
25
0
0
GB
Hi,

Apologies if this explanation is a little long winded but I want to make sure I cover everything in one go.

I am currently using this:
=IF(H4="EUM",IF(I4="SELF GEN",VLOOKUP(J4,Sheet3!$A$3:$B$7,2,0),""),"")

to return a result in Cell T4. This works fine for one particular instance but the issue I have is that Cell H4 has 3 different values (its a drop down format) and Cell I4 also has 2, again in drop down format. Depending on what is in Cells H4 & I4 would depend on which Vlookup to use, as the values to be returned would be different for each.

Assuming you are following me so far, this is going to be IMPOSSIBLE using a standard formula, as basically the nesting wont allow me to use that many IF's.

The total number of IF statements, covering everything is:

=IF(H4="EUM",IF(I4="SELF GEN",VLOOKUP(J4,Sheet3!$A$3:$B$7,2,0),""),"")
=IF(H4="EUM",IF(I4="WARM LEAD",VLOOKUP(J4,Sheet3!$D$3:$E$7,2,0),""),"")
=IF(H4="W/SPACE",IF(I4="WARM LEAD",VLOOKUP(J4,Sheet3!$A$11:$B$15,2,0),""),"")
=IF(H4="W/SPACE",IF(I4="SELF GEN",VLOOKUP(J4,Sheet3!$D$11:$E$15,2,0),""),"")
=IF(H4="A&M",IF(I4="WARM LEAD",VLOOKUP(J4,Sheet3!$G$3:$H$7,2,0),""),"")
=IF(H4="A&M",IF(I4="SELF GEN",VLOOKUP(J4,Sheet3!$J$3:$K$7,2,0),""),"")

Which, as you can see, is never going to work in a standard formula.

Is there a way to transfer the above block into VBA? I have tried a standard copy and paste, removing the "=" but it just Churns out an error which I don't understand.

I would need the result to be put into column T starting at row 4, since this will be used for multiple rows (starting at T4 and going all the way down to T200)

Since i am already begging for a lot of help as well, could this be put into a command button that will be at the top of the spreadsheet, to save me running the macro every time, I can just press the button...yes it's lazy.

and finally, I promise, is there a way to remove the #N/A result from the cell? as it is rather annoying and clutters up the screen unnecessarily.

I apologise if this seems like a rather complex thing, I would have been fine if it was just the one line but since the IF statement needs to cover multiple variables it is well outside my understanding.

Also, apologies if my explanation of what I require is both long winded and a little confusing, missed any vital information, or it just doesn't make sense.

Thank you so much in advance for any help
 
I think the following should work:
Code:
Sub chris()
Dim h$, i$
Dim r As Range
Dim x As Integer
Dim e As Boolean

x = 4

e = False
h$ = Cells(x, 8)
i$ = Cells(x, 9)
If h$ = "ENUM" Then
    If i$ = "SELF GEN" Then
        r = Range(Sheet3.Cells(3, 1), Sheet3.Cells(7, 2))
    Else
        If i$ = "WARM LEAD" Then r = Range(Sheet3.Cells(3, 4), Sheet3.Cells(7, 5)) Else e = True
    End If
Else
    If h$ = "W/SPACE" Then
        If i$ = "SELF GEN" Then
            r = Range(Sheet3.Cells(11, 1), Sheet3.Cells(15, 2))
        Else
            If i$ = "WARM LEAD" Then r = Range(Sheet3.Cells(11, 4), Sheet3.Cells(15, 5)) Else e = True
        End If
    Else
        If h$ = "A&M" Then
            If i$ = "SELF GEN" Then
                r = Range(Sheet3.Cells(3, 7), Sheet3.Cells(7, 8))
            Else
                If i$ = "WARM LEAD" Then r = Range(Sheet3.Cells(3, 10), Sheet3.Cells(7, 11)) Else e = True
            End If
        Else
        e = True
        End If
    End If
End If
If e = False Then
    Cells(x, 20) = WorksheetFunction.VLookup(Cells(x, 10), r, 2, 0)
End if
End Sub
 
Here's a even more codenced code based upon the relationships of your data and the ranges:
Code:
Sub chris2()
Dim h$, i$
Dim r As Range
Dim x As Integer, rX As Integer, rY As Integer
x = 4
h$ = Cells(x, 8)
i$ = Cells(x, 9)
If h$ = "ENUM" Or h$ = "W/SPACE" Or h$ = "A&M" Then
    If i$ = "SELF GEN" Or i$ = "WARM LEAD" Then
        If h$ <> "W/SPACE" Then
            rX = 3
        Else
            rX = 11
        End If
        If h$ <> "A&M" Then
            rY = 1
        Else
            rY = 7
        End If
        If i$ = "WARM LEAD" Then rY = rY + 3
        r = Range(Sheet3.Cells(rX, rY), Sheet3.Cells(rX + 4, rY + 1))
        Cells(x, 20) = WorksheetFunction.VLookup(Cells(x, 10), r, 2, 0)
    End If
End If
End Sub
 
Hi Zelgar,

I have copied and pasted both of these codes into my workbook and run them (with each variable) but it doesn't seem to do anything.

Have I missed something here?
 
Right now, it will only work for Row 4 because x is fixed. If you want it to loop throug all of your data, you'll need a Do Loop or something. (E.g. add the following after x = 8 line)
Code:
Do Until IS Empty(Cells,x,8)
and add at the end of your code before the END statement
Code:
x = x + 1
Loop

Also, are you running the macro when you're on the sheet where H4, I4 & J4 are located? If not, any of the Cells without a Sheet3. before them will need an associated worksheet. (e.g., Sheet1.)
 
Ok, however there is no

x=8
line. Do you mean the x=4 line?
 
I also appear to have another problem with the code.

When I copy and paste it into the workbook, then try to run it I keep getting a "Run-Time Error '1004' Application-defined or object-defined error"

Why would this keep appearing and what does it mean?
 
For the worksheet containing the H4 & I4 dropdowns, paste the following code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If (Target.Address = "$H$4" Or Target.Address = "$I$4") Then
        thread707_1711339
    End If
    
End Sub

Then create a module with the following code (make sure you change the Sheet2 references to the worksheet containing your "H4", "I4", "J" & "T" cells):

Code:
Public Sub thread707_1711339()
    Dim rgJtoT As Range
    Dim rgVLookup As Range
    
    Select Case Sheet2.Cells(4, 8).Value & Sheet2.Cells(4, 9).Value
        Case "EUMSELF GEN": Set rgVLookup = Sheet3.Range("A3:B7")
        Case "EUMWARM LEAD": Set rgVLookup = Sheet3.Range("D3:E7")
        Case "W/SPACESELF GEN": Set rgVLookup = Sheet3.Range("D11:D15")
        Case "W/SPACEWARMLEAD": Set rgVLookup = Sheet3.Range("A11:B15")
        Case "A&MSELF GEN": Set rgVLookup = Sheet3.Range("G3:H7")
        Case "A&MWARMLEAD": Set rgVLookup = Sheet3.Range("A3:B7")
        Case Else: Set rgVLookup = Nothing
    End Select
    
    Set rgJtoT = Sheet2.Range("J4:T4")
    Do While (rgJtoT(1).Value > "")
    
        rgJtoT(11).ClearContents
        If (Not rgVLookup Is Nothing) Then
            On Error Resume Next
            rgJtoT(11).Value = Application.WorksheetFunction.VLookup(rgJtoT(1).Value, rgVLookup, 2, False)
            On Error GoTo 0
        End If
    
        Set rgJtoT = rgJtoT.Offset(1)
    Loop
    
End Sub
 
Thank you Dave, this works great.

My only question is that when I run the code, I have to constantly "update" cell H4 (by just selecting something from the drop down) before new entries update.

For example

If I populate cells H12, I12 then input something into cell J12, Cell T12 wont input any information UNTIL I select something from cell H4.

Though not an extensive issue (seeing as cell H4 will always be populated) it's a little irksome. Any ideas?
 
The example I provided only uses H4 & I4 to control ALL values in columns J and T. I didn't know you wanted a unique H/I combination for each row.
 
I have to constantly "update" cell H4
Have a look here:
If (Target.Address = "$H$4" Or Target.Address = "$I$4") Then

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
It's not a problem. As I said, Cell H4 and I4 will always be populated anyway.

Thank you again for this coding, you have saved my sanity!
 
Another option in keeping with your original attempt to use formulas would be to name each of your lookup ranges with a prefix of "VLU" and the first letter from cell H4 and the first letter from cell I4. So your 6 named ranges would be, VLUES, VLUEW, VLUWS, VLUWW, VLUAS and VLUAW. Then paste the following formula into T4:

Code:
=IF(ISERROR(VLOOKUP(J4, INDIRECT("VLU" & LEFT(H4, 1) & LEFT(I4, 1)), 2, 0)), "", VLOOKUP(J4, INDIRECT("VLU" & LEFT(H4, 1) & LEFT(I4, 1)), 2, 0))

The "VLU" prefix (VLookup) isn't necessary but keeps the names from being confused with column references. This is a fairly simple formula compared to some I've seen and that's why I'm tempted to reach for a VBA solution instead of using formulas. To me, it's so much easier to decipher.
 
Sorry, I had an error in my code & where to put it. Here's the correct code, if you're interested
Code:
ub chris()
Dim h$, i$
Dim r As Range
Dim x As Integer
Dim e As Boolean

x = 4
Do Until IsEmpty(Cells(x, 8))
    e = False
    h$ = Cells(x, 8)
    i$ = Cells(x, 9)
    If h$ = "ENUM" Then
        If i$ = "SELF GEN" Then
            r = Range(Sheet3.Cells(3, 1), Sheet3.Cells(7, 2))
        Else
            If i$ = "WARM LEAD" Then r = Range(Sheet3.Cells(3, 4), Sheet3.Cells(7, 5)) Else e = True
        End If
    Else
        If h$ = "W/SPACE" Then
            If i$ = "SELF GEN" Then
                r = Range(Sheet3.Cells(11, 1), Sheet3.Cells(15, 2))
            Else
                If i$ = "WARM LEAD" Then r = Range(Sheet3.Cells(11, 4), Sheet3.Cells(15, 5)) Else e = True
            End If
        Else
            If h$ = "A&M" Then
                If i$ = "SELF GEN" Then
                    r = Range(Sheet3.Cells(3, 7), Sheet3.Cells(7, 8))
                Else
                    If i$ = "WARM LEAD" Then r = Range(Sheet3.Cells(3, 10), Sheet3.Cells(7, 11)) Else e = True
                End If
            Else
            e = True
            End If
        End If
    End If
    If e = False Then
        Cells(x, 20) = WorksheetFunction.VLookup(Cells(x, 10), r, 2, 0)
    End If
    x = x + 1
Loop

End Sub
 
I have had a slight play around with the coding, due to the changes asked for by my boss.

Using DaveInIowa's code I altered it as such:

Code:

and the main part to:

Code:

The problem is this:

Say for example the first set of information is "EUM Warm Lead", and the next 3 are "A&M Self Gen". when I "update" (by refreshing the row 4 drop down) I am getting the vlookup for EUM Warm Lead for ALL of the populated cells.

This means that I am populating incorrect information for other companies, which obviously isn't a good thing. Is anyone able to alter these codes so that it is unique to each row?

Apologies if the coding came out wrong, its the first time I have used the feature so I have no idea how it works.
 
ok so the codes didnt copy over...I have pasted them below:

Private Sub Worksheet_Change(ByVal Target As Range)

If (Target.Address = "$E" Or Target.Address = "$F") Then
thread707_1711339
End If

End Sub

&

Public Sub thread707_1711339()
Dim rgJtoT As Range
Dim rgVLookup As Range

Select Case Sheet1.Cells(4, 5).Value & Sheet1.Cells(4, 6).Value
Case "EUMSELF GEN": Set rgVLookup = Sheet3.Range("A3:B12")
Case "W/SPACESELF GEN": Set rgVLookup = Sheet3.Range("D17:E19")
Case "W/SPACEWARM LEAD": Set rgVLookup = Sheet3.Range("A17:B18")
Case "A&MSELF GEN": Set rgVLookup = Sheet3.Range("J3:K5")
Case "A&MWARM LEAD": Set rgVLookup = Sheet3.Range("G3:H4")
Case "HIMWARM LEAD": Set rgVLookup = Sheet3.Range("G17:H25")
Case Else: Set rgVLookup = Nothing
End Select

Set rgJtoT = Sheet1.Range("G4:Q4")
Do While (rgJtoT(1).Value > "")

rgJtoT(11).ClearContents
If (Not rgVLookup Is Nothing) Then
On Error Resume Next
rgJtoT(11).Value = Application.WorksheetFunction.VLookup(rgJtoT(1).Value, rgVLookup, 2, False)
On Error GoTo 0
End If

Set rgJtoT = rgJtoT.Offset(1)
Loop

End Sub
 
Hi Zelgar,

I thought I would give your code a try, having made a few minor alterations to the code to allow for changes but it seems to be spitting out the error "Else without IF"

I have pasted the code below and made the line this is coming from Bold for ease.

Sub chris()
Dim h$, i$
Dim r As Range
Dim x As Integer
Dim e As Boolean

x = 4
Do Until IsEmpty(Cells(x, 8))
e = False
f$ = Cells(x, 6)
g$ = Cells(x, 7)
If f$ = "Wspace" Then
If g$ = "Self Gen" Then
r = Range(Sheet2.Cells(20, 1), Sheet2.Cells(22, 2))
Else
If g$ = "Warm Lead" Then r = Range(Sheet2.Cells(20, 3), Sheet3.Cells(21, 4)) Else e = True
End If
Else
If f$ = "EUM" Then
r = Range(Sheet2.Cells(20, 5), Sheet2.Cells(29, 6))
End If
Else
If f$ = "HIM" Then
r = Range(Sheet2.Cells(20, 7), Sheet2.Cells(28, 8))
End If
If f$ = "A and M" Then
If g$ = "Self Gen" Then
r = Range(Sheet2.Cells(20, 9), Sheet2.Cells(22, 10))
Else
If g$ = "Warm Lead" Then r = Range(Sheet2.Cells(20, 11), Sheet3.Cells(21, 12)) Else e = True
End If
Else
e = True
End If
End If
End If
If e = False Then
Cells(x, 20) = WorksheetFunction.VLookup(Cells(x, 10), r, 2, 0)
End If
x = x + 1
Loop

Any ideas why this is happening?
 
Chris,

Your code is an unintelliible ratsnest of unmatched block syntax.

I make it a practice to code an antire bock syntax before filling in the code details AND I indent the code within each block for clarity and ease of understanding.

Fon instance, if I want a Do Loop...
Code:
Sub SkipVought
   Dim x as long

   do

   loop
Now I start to fill in THIS block
Code:
Sub SkipVought
   Dim x as long

   do Until IsEmpty(Cells(x, 8))
        e = False
        f$ = Cells(x, 6)
        g$ = Cells(x, 7)
        If f$ = "Wspace" Then

        Else

        End if
   loop
Then start to fill in this block...
Sub SkipVought
Dim x as long

do Until IsEmpty(Cells(x, 8))
e = False
f$ = Cells(x, 6)
g$ = Cells(x, 7)
If f$ = "Wspace" Then
If g$ = "Self Gen" Then

Else
If g$ = "Warm Lead" Then

Else

End If
End If
Else

End if
loop
[/code]
Then fill in this block and so on.

YOU will then discover where you failed to enter a proper matched structure.



Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
It's really hard to follow your code. As Skip indicated, indenting your commands makes it a lot easier to follow and read your code. You probably have some issue with your "End If" & your "Else" commands. You don't need an "End If" Command if your "IF" statement has an "If .. Then ... Else ..." on the same line (or if it's only a "If ... Then ..." Statement and there isn't any "Else")

I'd suggest you make the following change:
1. Start indenting your code so it's obvious how your data is linked together/structured properly
2. If your "If" statement only has one item and no "Else" Statement (e.g.,
Code:
If f$ = "EUM" Then
      r = Range(Sheet2.Cells(20, 5), Sheet2.Cells(29, 6))
End If
simplify it to the following
Code:
If f$ = "EUM" Then r = Range(Sheet2.Cells(20, 5), Sheet2.Cells(29, 6))
3. Make certain that you have your relationships correctly established for your "If" Statements. There can only be one "Else" Statement per "If" Statement.
4. Remember when you're using the Cells command it's in the (Row, Column) format.
 
I think the following code will do what you want:
Code:
Sub chris2()
Dim h$, i$
Dim r As Range
Dim x As Integer, rX As Integer, rY As Integer
x = 4
Do Until IsEmpty(Cells(x, 8))
    h$ = Cells(x, 6)
    i$ = Cells(x, 7)
    If (h$ = "EUM" Or h$ = "Wspace" Or h$ = "A and M" Or h$ = "HIM") And (i$ = "Self Gen" Or i$ = "Warm Lead") Then
        Select Case h$ & i$
            Case "WspaceSelf Gen":   r = Range(Sheet2.Cells(20, 1), Sheet2.Cells(22, 2))
            Case "WspaceWarm Lead":  r = Range(Sheet2.Cells(20, 3), Sheet2.Cells(21, 4))
            Case "WspaceWarm Lead":  r = Range(Sheet2.Cells(20, 3), Sheet2.Cells(21, 4))
            Case "EUMSelf Gen":      r = Range(Sheet2.Cells(20, 5), Sheet2.Cells(29, 6))
            Case "EUMWarm Lead":     r = Range(Sheet2.Cells(20, 5), Sheet2.Cells(29, 6))
            Case "HIMSelf Gen":      r = Range(Sheet2.Cells(20, 7), Sheet2.Cells(28, 8))
            Case "HIMWarm Lead":     r = Range(Sheet2.Cells(20, 7), Sheet2.Cells(28, 8))
            Case "A and MSelf Gen":  r = Range(Sheet2.Cells(20, 9), Sheet2.Cells(22, 10))
            Case "A and MWarm Lead": r = Range(Sheet2.Cells(20, 11), Sheet2.Cells(21, 12))
        End Select
        Cells(x, 20) = WorksheetFunction.VLookup(Cells(x, 10), r, 2, 0)
    End If
Loop
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top