VBA Vlookup loop with if statement

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
370
Hi, I am would like to achieve the following if someone could help. I tried to scrap some code online, see below, but I don't know enough to complete the job.

In my workbook, I have a sheet named "QUOTE" and I need to total the amount in the cells in a specific column that meet a certain criteria based on the IF statement. I know we can have the background color change if the criteria is met, and then I can do a SUMIF by color, but I assume it can be done in macro. Below is the information - I'm sure I left something out! Note I need to repeat this process in several columns which I hope to do on my own once I have the format. Thanks in advance.

Vlookup value: sheet QUOTE, C24 and down the column if cells have data
Table array: sheet COSTS, A2:AZ1000, column AF
If statement: if cell in column AF = "RE"
I would like the sum total of those cells to be in sheet QUOTE cell CL15

A second column would be:
Vlookup value: sheet QUOTE, D24 and down the column if cells have data
Table array: sheet COSTS, A2:AZ1000, column AF
If statement: if cell in column AF = "RE"
I would like the sum total of those cells to be in sheet QUOTE cell CP15

VBA Code:
Sub ROLLEASE()  
    Dim N As Long, i As Long, j As Long
    N = Worksheets("COSTS").Cells(Rows.Count, "B").End(xlUp).Row
    j = 24
    For i = 2 To N
        If Worksheets("COSTS").Cells(i, "AF").Value = "RE" Then
        If Worksheets("QUOTE").Cells(j, "CL").Value > 0 Then
            Cells(j, "CL").Interior.color = 65535
            j = j + 1
        End If
        End If
    Next i
End Sub
 
I have written this so that is is very easy for you to modify to select which column you want added into column EL
I have created an array called "letarr" into which you just put the letters of the columns you want to add into columnn EL. the code converts the letter codes into numbers and then uses that in a loop to add the columns in. You can expand the array letarr just by adding more letters , by using eactly the same format, the code detects how many letters there are in the array automatically
VBA Code:
Sub dictionarydemo()
' column CL is column 90
' column EL is column 142
' Lookup the value in Column C in column A of COSTS if match found, check value in column AF of COSTS
' if this is equal to "RE" then copy the value in column CL of quotes to Column EL
'Dim colnos()
' set the columns that you want added into column EL here
letarr = Array("C", "D", "DE", "AX", "AB")
ReDim colno(0 To UBound(letarr))
For i = 0 To UBound(letarr)
colno(i) = Range(letarr(i) & 1).Column
Next i

' this shows the use of a dictionary to copy a value to a matching worksheet
   Dim Ary As Variant
   Dim Dic As Object
 
   Set Dic = CreateObject("Scripting.dictionary")
   With Worksheets("COSTS")
   ' load lookup date into a varaint array
      Ary = .Range("$A$2:$AZ$700").Value
   End With
   For i = 1 To UBound(Ary)
      Dic(Ary(i, 1)) = Ary(i, 32)  ' load the lookup column into the dictionary
   Next i
   
   With Worksheets("Quotes")
    lastrow = .Cells(Rows.Count, "C").End(xlUp).Row  ' check column C for the last row
    inarr = .Range(.Cells(2, 3), .Cells(lastrow, 3)) ' load all the value to lookup
    allcols = .Range(.Cells(2, 1), .Cells(lastrow, 141)) ' load all columns up column EK
    colel = .Range(.Cells(2, 142), .Cells(lastrow, 142))
      For j = 1 To UBound(inarr)
         If (Dic(inarr(j, 1))) = "RE" Then 'this matches the value given by the index inarr(i,1) in the dictionary
            colel(j, 1) = allcols(j, colno(0)) ' copy first column into column el
            For k = 1 To UBound(colno)
                colel(j, 1) = colel(j, 1) + allcols(j, colno(k)) ' add the other columns in taking the index from the array colno
            Next k
         End If
      Next j
     .Range(.Cells(2, 142), .Cells(lastrow, 142)) = colel
     End With
End Sub
Wow, you're ahead of me. A couple of wrinkles I just realized.

The vlookup I gave you which looks at sheet quote column C. I only need one column, CM (change from CL) to move to EL. If you leave it the new way I guess it doesn't hurt.

I need a 2nd vlookup which looks at quote column D. Everything else about the lookup remains the same as the current one. It will be in this section where I will need to add the additional columns. Both vlokoups should still total into the same column EL.

The program should only run if cell EL19 has certain US State code such as, MA, NH, etc. I would need to add or remove states as needed.

Thanks
 
Upvote 0

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
that should be very easy to do starting from the code I have written. I suggest you do it with two separate subs, and I suggest you do the second one first, because that copies the first value into EL and the adds the rest on. Then modify the second one so that it only adds to the values in EL, since there is only one column you don't need the loop you can just add the value into colel rather than copy it into.
Your requirements are growing all the time, I think you should try to understand the code so that you can modify it as required , if you have any querie about the code do ask
 
Upvote 0
that should be very easy to do starting from the code I have written. I suggest you do it with two separate subs, and I suggest you do the second one first, because that copies the first value into EL and the adds the rest on. Then modify the second one so that it only adds to the values in EL, since there is only one column you don't need the loop you can just add the value into colel rather than copy it into.
Your requirements are growing all the time, I think you should try to understand the code so that you can modify it as required , if you have any querie about the code do ask
Hi, I usually do that with simpler code - I'm just a novice and this is way past me. But I may be able to do it with a little help and questions.
 
Upvote 0
Hi, I usually do that with simpler code - I'm just a novice and this is way past me. But I may be able to do it with a little help and questions.
Hi, I kind of understand the code, at least enough to make the changes I need. I'm pretty much 99% the way there. And if you could look at an exit sub line I wrote below.

I nullified the 3 lines below to remove the loop to only handle the one col. It seemed to work. I tested running one then the other and it worked fine as well.

VBA Code:
If (Dic(inarr(j, 1))) = "RE" Then 'this matches the value given by the index inarr(i,1) in the dictionary
            'colel(j, 1) = allcols(j, colno(0)) ' copy first column into column el
            'For k = 1 To UBound(colno)
                colel(j, 1) = colel(j, 1) + allcols(j, colno(k)) ' add the other columns in taking the index from the array colno
            'Next k
         End If

I will need to add a few more State codes. Can you suggest a better way?

VBA Code:
If Sheets("QUOTE").Range("EL18").Value <> "MA" And Sheets("QUOTE").Range("EL18").Value <> "CT" Then 
Exit Sub
    End If

Thanks
 
Upvote 0
If (Dic(inarr(j, 1))) = "RE" Then 'this matches the value given by the index inarr(i,1) in the dictionary
'colel(j, 1) = allcols(j, colno(0)) ' copy first column into column el
'For k = 1 To UBound(colno)
colel(j, 1) = colel(j, 1) + allcols(j, colno(k)) ' add the other columns in taking the index from the array colno
'Next k
End If
In this code K is undefined (because you got rid of the loop, so k happens to default to zero which also happens to be the index into the first value in colno. So the fact it worked was a bit by accident. I would prefer to change the K to zero so that anybody looking at the code in the future wouldn't be confused by it. If you decided to add some code before this bit of code that used k as an index this would stop working.
You could use a case statement instead of the multiple If.
If you really have a lot of them to check , then you could define an array ( just as i have done for the column letters) and then loop through the array checking them all and setting a flag which you can then test in the if statement
 
Upvote 0
Solution
Hi, I'm on my way...thanks again for all the help and leading me to try and figure it out. If I run into a roadblocks I'll reach out. Be well.
 
Upvote 0
Hi, Ran into a hiccup. When I add col "DQ" in the "letarr" array line, I get an error. run time error 13, type mismatch.

VBA Code:
[CODE=vba]Sub dictionarydemo()
' column CL is column 90
' column EL is column 142
' Lookup the value in Column C in column A of COSTS if match found, check value in column AF of COSTS
' if this is equal to "RE" then copy the value in column CL of quotes to Column EL
'Dim colnos()
' set the columns that you want added into column EL here
letarr = Array("CP", "CQ", "DQ")
ReDim colno(0 To UBound(letarr))
For i = 0 To UBound(letarr)
colno(i) = Range(letarr(i) & 1).Column
Next i

' this shows the use of a dictionary to copy a value to a matching worksheet
   Dim Ary As Variant
   Dim Dic As Object
 
   Set Dic = CreateObject("Scripting.dictionary")
   With Worksheets("COSTS")
   ' load lookup date into a varaint array
      Ary = .Range("$A$2:$AZ$700").Value
   End With
   For i = 1 To UBound(Ary)
      Dic(Ary(i, 1)) = Ary(i, 32)  ' load the lookup column into the dictionary
   Next i
    
   With Worksheets("Quote")
    Lastrow = .Cells(Rows.Count, "D").End(xlUp).Row  ' check column C for the last row
    inarr = .Range(.Cells(2, 4), .Cells(Lastrow, 4)) ' load all the value to lookup
    allcols = .Range(.Cells(2, 1), .Cells(Lastrow, 141)) ' load all columns up column EK
    colel = .Range(.Cells(2, 142), .Cells(Lastrow, 142))
      For j = 1 To UBound(inarr)
         If (Dic(inarr(j, 1))) = "RE" Then 'this matches the value given by the index inarr(i,1) in the dictionary
            colel(j, 1) = allcols(j, colno(0)) ' copy first column into column el
            For k = 1 To UBound(colno)
                colel(j, 1) = colel(j, 1) + allcols(j, colno(k)) ' add the other columns in taking the index from the array colno
            Next k
         End If
      Next j
     .Range(.Cells(2, 142), .Cells(Lastrow, 142)) = colel
     End With
End Sub
[/CODE]
 
Upvote 0
VBA Code:
colel(j, 1) = colel(j, 1) + allcols(j, colno(k)) ' add the other columns in taking the index from the array colno
 
Upvote 0
It is because the column dq is beyond the end of the array allcols, as it says in the comment it only loads up to column ek. So you need to change the number 141 to whatever the column number dq is. Sorry not at a PC at themoment
 
Upvote 0

Forum statistics

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

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