VBA Vlookup loop with if statement

[Shadkng]

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

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

 

[offthelip]

I need the cell values in column CL in sheets "quote" to move to col CV if the vlookup finds a match, instead of the value found in sheet "costs".

I don't understand what you mean by ths statement, what is the point of doing a lookup if you don't copy some information from the COSTS sheet?? Are you just checking that it can be found on the costs sheets?
Secondly if you are doing this for multiple columns what do you mean by that? Do you need to lookup Column C against column A on Costs again and copy another column because there is fast way of doing that so that you don't need to look up again.

 

[Shadkng]

I don't understand what you mean by ths statement, what is the point of doing a lookup if you don't copy some information from the COSTS sheet?? Are you just checking that it can be found on the costs sheets?
Secondly if you are doing this for multiple columns what do you mean by that? Do you need to lookup Column C against column A on Costs again and copy another column because there is fast way of doing that so that you don't need to look up again.

I need the value in sheet quote, col CL to copy to col EL (not CV)in quote. This copy should be based on a vlookup from quote col C to sheet costs col A and if "RE" is contained in col 32. If not, it does nothing. I would need to repeat this task several times - the only difference will be the copy might be from col CP, for example, to either a new column, or better if the value could be "added" to the same cells in column EL where I would eventually get a total of all the columns. Does this make sense?

By the way, I know I can achieve this using basic vlookup formulas instead of a macro. Sometimes I don't realize that it can get a little complicated. So it's no problem if you feel it's too much work, etc. I don't want to take advantage of the help you guys provide. Whatever you decide is fine with me. Thanks

 

[offthelip]

I think I have understood so try this, only a slight modification:

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

' this shows the use of a dictionary to copy a value to a matching worksheet
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim outarr() As Variant
   
   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
    ColCL = .Range(.Cells(2, 90), .Cells(lastrow, 90))
    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) = ColCL(j, 1)
      Next j
     .Range(.Cells(2, 90), .Cells(lastrow, 90)) = ColCL
     End With
End Sub

 

[Shadkng]

I think I have understood so try this, only a slight modification:

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

' this shows the use of a dictionary to copy a value to a matching worksheet
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim outarr() As Variant
  
   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
    ColCL = .Range(.Cells(2, 90), .Cells(lastrow, 90))
    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) = ColCL(j, 1)
      Next j
     .Range(.Cells(2, 90), .Cells(lastrow, 90)) = ColCL
     End With
End Sub

I got a compile error "next without for" and "next j" was hi-lighted.

 

[offthelip]

sorry left out an end if

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

' this shows the use of a dictionary to copy a value to a matching worksheet
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim outarr() As Variant
 
   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
    ColCL = .Range(.Cells(2, 90), .Cells(lastrow, 90))
    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) = ColCL(j, 1)
         End If
      Next j
     .Range(.Cells(2, 142), .Cells(lastrow, 142)) = ColEL   ' change this line as well
     End With
End Sub

I spotted another error I picked the wrong array when writing back to the worksheet change CL to El and 90 to 142 3 lines before the end

 

[Shadkng]

sorry left out an end if

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

' this shows the use of a dictionary to copy a value to a matching worksheet
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim outarr() As Variant
 
   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
    ColCL = .Range(.Cells(2, 90), .Cells(lastrow, 90))
    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) = ColCL(j, 1)
         End If
      Next j
     .Range(.Cells(2, 142), .Cells(lastrow, 142)) = ColEL   ' change this line as well
     End With
End Sub

I spotted another error I picked the wrong array when writing back to the worksheet change CL to El and 90 to 142 3 lines before the end

Worked perfectly. Let's say I had to do this for 15 or 20 columns would all of this have to be written again for each? If not, then possibly you can add another column and I could duplicate.
Also, can the cells in the additional columns value be added the same column EL?

 

[offthelip]

I would just expand the clcol array . Which columns do you wanted added in

 

[Shadkng]

I would just expand the clcol array . Which columns do you wanted added in

 

[Shadkng]

let me come back to you soon. Want to be sure I get my facts right. Thanks

 

[offthelip]

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

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