VBA search tool to return data and cell color

S

StillUnderstanding

Board Regular
Joined
Jan 30, 2021
Messages
80
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

This is my first post so please go easy on me!! I have an excel file that allows me to enter in data in 2 cells and return any matching values, it works great but when it returns the data it is not returning the cell color.

So when a cell matches it should bring back the content and the color.

here is the code I am using at the minute

VBA Code: 
Sub Lookup()


Application.ScreenUpdating = False
Dim wSht As Worksheet, crow As Long, frow As Long, i As Long, wThis As Worksheet
Dim searchCode As String

Set wThis = Sheet1
searchCode = Trim(wThis.Range("B3"))
ActiveSheet.Unprotect
wThis.Range("A6:AL" & Rows.Count) = Empty

crow = 6
If Trim(wThis.Range("C3")) = "Y" Then
    Set wSht = Sheet2
    Dim rng As Range
       
    Dim CnumA As Integer
    Dim CnumB As Integer
    Dim CnumC As Integer
    Dim CnumD As Integer
    Dim CnumE As Integer
    Dim CnumF As Integer
    Dim CnumG As Integer
    Dim CnumH As Integer
    Dim CnumI As Integer
    Dim CnumJ As Integer
    Dim CnumK As Integer
    Dim CnumL As Integer
    Dim CnumM As Integer
    Dim CnumN As Integer
    Dim CnumO As Integer
    Dim CnumP As Integer
    Dim CnumQ As Integer
    Dim CnumR As Integer
    Dim CnumS As Integer
    Dim CnumT As Integer
    Dim CnumU As Integer
    Dim CnumV As Integer
   
    Dim LookCnum As Integer
   
    Dim ColA As String
    Dim ColB As String
    Dim ColC As String
    Dim ColD As String
    Dim ColE As String
    Dim ColF As String
    Dim ColG As String
    Dim ColH As String
    Dim ColI As String
    Dim ColJ As String
    Dim ColK As String
    Dim ColL As String
    Dim ColM As String
    Dim ColN As String
    Dim ColO As String
    Dim ColP As String
    Dim ColQ As String
    Dim ColR As String
    Dim ColS As String
    Dim ColT As String
    Dim ColU As String
    Dim ColV As String
   
    Dim LookCol As String
   
    ColA = Cells(5, 1).Value
    ColB = Cells(5, 2).Value
    ColC = Cells(5, 3).Value
    ColD = Cells(5, 4).Value
    ColE = Cells(5, 5).Value
    ColF = Cells(5, 6).Value
    ColG = Cells(5, 7).Value
    ColH = Cells(5, 8).Value
    ColI = Cells(5, 9).Value
    ColJ = Cells(5, 10).Value
    ColK = Cells(5, 11).Value
    ColL = Cells(5, 12).Value
    ColM = Cells(5, 13).Value
    ColN = Cells(5, 14).Value
    ColO = Cells(5, 15).Value
    ColP = Cells(5, 16).Value
    ColQ = Cells(5, 17).Value
    ColR = Cells(5, 18).Value
    ColS = Cells(5, 19).Value
    ColT = Cells(5, 20).Value
    ColU = Cells(5, 21).Value
    ColV = Cells(5, 22).Value
       
    Set rng = Range("Raw_Data_Headers") 'You only need the headers and not all the table
   
    'variable used to filter data
    LookCol = Cells(2, 2).Value
   
    LookCnum = Application.WorksheetFunction.Match(LookCol, rng, 0)
   
    LookCol = Split(Cells(1, LookCnum).Address, "$")(1)
   
    'looking for column numbers
    CnumA = Application.WorksheetFunction.Match(ColA, rng, 0)
    CnumB = Application.WorksheetFunction.Match(ColB, rng, 0)
    CnumC = Application.WorksheetFunction.Match(ColC, rng, 0)
    CnumD = Application.WorksheetFunction.Match(ColD, rng, 0)
    CnumE = Application.WorksheetFunction.Match(ColE, rng, 0)
    CnumF = Application.WorksheetFunction.Match(ColF, rng, 0)
    CnumG = Application.WorksheetFunction.Match(ColG, rng, 0)
    CnumH = Application.WorksheetFunction.Match(ColH, rng, 0)
    CnumI = Application.WorksheetFunction.Match(ColI, rng, 0)
    CnumJ = Application.WorksheetFunction.Match(ColJ, rng, 0)
    CnumK = Application.WorksheetFunction.Match(ColK, rng, 0)
    CnumL = Application.WorksheetFunction.Match(ColL, rng, 0)
    CnumM = Application.WorksheetFunction.Match(ColM, rng, 0)
    CnumN = Application.WorksheetFunction.Match(ColN, rng, 0)
    CnumO = Application.WorksheetFunction.Match(ColO, rng, 0)
    CnumP = Application.WorksheetFunction.Match(ColP, rng, 0)
    CnumQ = Application.WorksheetFunction.Match(ColQ, rng, 0)
    CnumR = Application.WorksheetFunction.Match(ColR, rng, 0)
    CnumS = Application.WorksheetFunction.Match(ColS, rng, 0)
    CnumT = Application.WorksheetFunction.Match(ColT, rng, 0)
    CnumU = Application.WorksheetFunction.Match(ColU, rng, 0)
    CnumV = Application.WorksheetFunction.Match(ColV, rng, 0)
   
       
    'Convert To Column Letter
    ColA = Split(Cells(1, CnumA).Address, "$")(1)
    ColB = Split(Cells(1, CnumB).Address, "$")(1)
    ColC = Split(Cells(1, CnumC).Address, "$")(1)
    ColD = Split(Cells(1, CnumD).Address, "$")(1)
    ColE = Split(Cells(1, CnumE).Address, "$")(1)
    ColF = Split(Cells(1, CnumF).Address, "$")(1)
    ColG = Split(Cells(1, CnumG).Address, "$")(1)
    ColH = Split(Cells(1, CnumH).Address, "$")(1)
    ColI = Split(Cells(1, CnumI).Address, "$")(1)
    ColJ = Split(Cells(1, CnumJ).Address, "$")(1)
    ColK = Split(Cells(1, CnumK).Address, "$")(1)
    ColL = Split(Cells(1, CnumL).Address, "$")(1)
    ColM = Split(Cells(1, CnumM).Address, "$")(1)
    ColN = Split(Cells(1, CnumN).Address, "$")(1)
    ColO = Split(Cells(1, CnumO).Address, "$")(1)
    ColP = Split(Cells(1, CnumP).Address, "$")(1)
    ColQ = Split(Cells(1, CnumQ).Address, "$")(1)
    ColR = Split(Cells(1, CnumR).Address, "$")(1)
    ColS = Split(Cells(1, CnumS).Address, "$")(1)
    ColT = Split(Cells(1, CnumT).Address, "$")(1)
    ColU = Split(Cells(1, CnumU).Address, "$")(1)
    ColV = Split(Cells(1, CnumV).Address, "$")(1)
 
    frow = wSht.Range("V" & Rows.Count).End(xlUp).Row
   
    For i = 2 To frow
        If wSht.Range(LookCol & i) = searchCode Then
            wThis.Range("A" & crow) = wSht.Range(ColA & i)
            wThis.Range("B" & crow) = wSht.Range(ColB & i)
            wThis.Range("C" & crow) = wSht.Range(ColC & i)
            wThis.Range("d" & crow) = wSht.Range(ColD & i)
            wThis.Range("e" & crow) = wSht.Range(ColE & i)
            wThis.Range("f" & crow) = wSht.Range(ColF & i)
            wThis.Range("g" & crow) = wSht.Range(ColG & i)
            wThis.Range("h" & crow) = wSht.Range(ColH & i)
            wThis.Range("i" & crow) = wSht.Range(ColI & i)
            wThis.Range("j" & crow) = wSht.Range(ColJ & i)
            wThis.Range("k" & crow) = wSht.Range(ColK & i)
            wThis.Range("l" & crow) = wSht.Range(ColL & i)
            wThis.Range("m" & crow) = wSht.Range(ColM & i)
            wThis.Range("n" & crow) = wSht.Range(ColN & i)
            wThis.Range("o" & crow) = wSht.Range(ColO & i)
            wThis.Range("p" & crow) = wSht.Range(ColP & i)
            wThis.Range("q" & crow) = wSht.Range(ColQ & i)
            wThis.Range("r" & crow) = wSht.Range(ColR & i)
            wThis.Range("S" & crow) = wSht.Range(ColS & i)
            wThis.Range("T" & crow) = wSht.Range(ColT & i)
            wThis.Range("U" & crow) = wSht.Range(ColU & i)
            wThis.Range("V" & crow) = wSht.Range(ColV & i)
            crow = crow + 1
        End If
    Next i
End If

If Trim(wThis.Range("D3")) = "Y" Then
    Set wSht = Sheet2
   
       
    ColA = Cells(5, 1).Value
    ColB = Cells(5, 2).Value
    ColC = Cells(5, 3).Value
    ColD = Cells(5, 4).Value
    ColE = Cells(5, 5).Value
    ColF = Cells(5, 6).Value
    ColG = Cells(5, 7).Value
    ColH = Cells(5, 8).Value
    ColI = Cells(5, 9).Value
    ColJ = Cells(5, 10).Value
    ColK = Cells(5, 11).Value
    ColL = Cells(5, 12).Value
    ColM = Cells(5, 13).Value
    ColN = Cells(5, 14).Value
    ColO = Cells(5, 15).Value
    ColP = Cells(5, 16).Value
    ColQ = Cells(5, 17).Value
    ColR = Cells(5, 18).Value
    ColS = Cells(5, 19).Value
    ColT = Cells(5, 20).Value
    ColU = Cells(5, 21).Value
    ColV = Cells(5, 22).Value
   
    Set rng = Range("Raw_Data_Headers")
   
    'variable used to filter data
    LookCol = Right(Cells(2, 2).Value, Len(Cells(2, 2).Value) - 7)
   
    LookCnum = Application.WorksheetFunction.Match(LookCol, rng, 0)
   
    LookCol = Split(Cells(1, LookCnum).Address, "$")(1)
   
    'looking for column numbers
    CnumA = Application.WorksheetFunction.Match(ColA, rng, 0)
    CnumB = Application.WorksheetFunction.Match(ColB, rng, 0)
    CnumC = Application.WorksheetFunction.Match(ColC, rng, 0)
    CnumD = Application.WorksheetFunction.Match(ColD, rng, 0)
    CnumE = Application.WorksheetFunction.Match(ColE, rng, 0)
    CnumF = Application.WorksheetFunction.Match(ColF, rng, 0)
    CnumG = Application.WorksheetFunction.Match(ColG, rng, 0)
    CnumH = Application.WorksheetFunction.Match(ColH, rng, 0)
    CnumI = Application.WorksheetFunction.Match(ColI, rng, 0)
    CnumJ = Application.WorksheetFunction.Match(ColJ, rng, 0)
    CnumK = Application.WorksheetFunction.Match(ColK, rng, 0)
    CnumL = Application.WorksheetFunction.Match(ColL, rng, 0)
    CnumM = Application.WorksheetFunction.Match(ColM, rng, 0)
    CnumN = Application.WorksheetFunction.Match(ColN, rng, 0)
    CnumO = Application.WorksheetFunction.Match(ColO, rng, 0)
    CnumP = Application.WorksheetFunction.Match(ColP, rng, 0)
    CnumQ = Application.WorksheetFunction.Match(ColQ, rng, 0)
    CnumR = Application.WorksheetFunction.Match(ColR, rng, 0)
    CnumS = Application.WorksheetFunction.Match(ColS, rng, 0)
    CnumT = Application.WorksheetFunction.Match(ColT, rng, 0)
    CnumU = Application.WorksheetFunction.Match(ColU, rng, 0)
    CnumV = Application.WorksheetFunction.Match(ColV, rng, 0)

   
       
    'Convert To Column Letter
    ColA = Split(Cells(1, CnumA).Address, "$")(1)
    ColB = Split(Cells(1, CnumB).Address, "$")(1)
    ColC = Split(Cells(1, CnumC).Address, "$")(1)
    ColD = Split(Cells(1, CnumD).Address, "$")(1)
    ColE = Split(Cells(1, CnumE).Address, "$")(1)
    ColF = Split(Cells(1, CnumF).Address, "$")(1)
    ColG = Split(Cells(1, CnumG).Address, "$")(1)
    ColH = Split(Cells(1, CnumH).Address, "$")(1)
    ColI = Split(Cells(1, CnumI).Address, "$")(1)
    ColJ = Split(Cells(1, CnumJ).Address, "$")(1)
    ColK = Split(Cells(1, CnumK).Address, "$")(1)
    ColL = Split(Cells(1, CnumL).Address, "$")(1)
    ColM = Split(Cells(1, CnumM).Address, "$")(1)
    ColN = Split(Cells(1, CnumN).Address, "$")(1)
    ColO = Split(Cells(1, CnumO).Address, "$")(1)
    ColP = Split(Cells(1, CnumP).Address, "$")(1)
    ColQ = Split(Cells(1, CnumQ).Address, "$")(1)
    ColR = Split(Cells(1, CnumR).Address, "$")(1)
    ColS = Split(Cells(1, CnumS).Address, "$")(1)
    ColT = Split(Cells(1, CnumT).Address, "$")(1)
    ColU = Split(Cells(1, CnumU).Address, "$")(1)
    ColV = Split(Cells(1, CnumV).Address, "$")(1)
 
    frow = wSht.Range("V" & Rows.Count).End(xlUp).Row
   
    For i = 2 To frow
        If wSht.Range(LookCol & i) = searchCode Then
            wThis.Range("A" & crow) = wSht.Range(ColA & i)
            wThis.Range("B" & crow) = wSht.Range(ColB & i)
            wThis.Range("C" & crow) = wSht.Range(ColC & i)
            wThis.Range("d" & crow) = wSht.Range(ColD & i)
            wThis.Range("e" & crow) = wSht.Range(ColE & i)
            wThis.Range("f" & crow) = wSht.Range(ColF & i)
            wThis.Range("g" & crow) = wSht.Range(ColG & i)
            wThis.Range("h" & crow) = wSht.Range(ColH & i)
            wThis.Range("i" & crow) = wSht.Range(ColI & i)
            wThis.Range("j" & crow) = wSht.Range(ColJ & i)
            wThis.Range("k" & crow) = wSht.Range(ColK & i)
            wThis.Range("l" & crow) = wSht.Range(ColL & i)
            wThis.Range("m" & crow) = wSht.Range(ColM & i)
            wThis.Range("n" & crow) = wSht.Range(ColN & i)
            wThis.Range("o" & crow) = wSht.Range(ColO & i)
            wThis.Range("p" & crow) = wSht.Range(ColP & i)
            wThis.Range("q" & crow) = wSht.Range(ColQ & i)
            wThis.Range("r" & crow) = wSht.Range(ColR & i)
            wThis.Range("S" & crow) = wSht.Range(ColS & i)
            wThis.Range("T" & crow) = wSht.Range(ColT & i)
            wThis.Range("U" & crow) = wSht.Range(ColU & i)
            wThis.Range("V" & crow) = wSht.Range(ColV & i)
            crow = crow + 1
        End If
    Next i
   
  ActiveSheet.Protect
End If
Application.ScreenUpdating = True

MsgBox "Process Complete" & vbNewLine & _
        crow - 6 & " Records found"
       

End Sub
 
Last edited by a moderator:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
Your code is very long and inefficient, it will also be very slow because you are accessing the worksheet multiple times, it could be much more compact and much mcuh faster.
I have done some modifications to introduce the idea of using some basic arrays and doing a few thing in loops.
One really basic thing to learn is that although in EXCEL it uses letters for columns and number for rows, in VBA one can address cells using numbers for columns and rows. This means all your efforts to convert a number of a column to a letter is unnecessary . If you ever do need to find the letter of a column for column A to this equation works very well, It works by adding 64 to the number and then finding the ascii character that correspond:
tt= 4 ' i.e column D
colletter = Chr(64+tt)
I have commented out the unecessary code for half of it nad adding equivalent code ( but it is untested) . Note I have NOT made efforts to really speed up the code becuase that would make even more difficult to understand. This involves getting rid of all the refence to ranges and celsl and using variant arrays instead.
Finally you are saying you want to copy the colour of a cell using VBA. This is the real reason I decided to answer this query, because in a well designed system colour should be used to assist in dispaying the data, and conditional formatting can be useful in doing that. In a well designed VBA system Colour should never be used to "store" data or as a source of data. If it reflects some real world characteristic then it should be held as a data item in a separate coluimn. This is because dealing with colours in VBA is really quite complicated and it makes vBA really slow because colour can only be detected one cell at a time, while values can be read from the worksheet the entire sheet in one go.
Here is my updated code:
VBA Code: 
Sub Lookup()


Application.ScreenUpdating = False
Dim wSht As Worksheet, crow As Long, frow As Long, i As Long, wThis As Worksheet
Dim searchCode As String

Set wThis = Sheet1
searchCode = Trim(wThis.Range("B3"))
ActiveSheet.Unprotect
wThis.Range("A6:AL" & Rows.Count) = Empty

crow = 6
If Trim(wThis.Range("C3")) = "Y" Then
    Set wSht = Sheet2
    Dim rng As Range
       
   
    Dim LookCnum As Integer
   
   
    Dim LookCol As String
   
    row5values = Range(Cells(5, 1), Cells(5, 22)) ' this pick up all the values below in one line in an array
    Dim row5col(1 To 22) As Long   ' we use this array to store the column numbers a found in in raw data headers
    
'    ColA = Cells(5, 1).Value
'    ColB = Cells(5, 2).Value
'    ColC = Cells(5, 3).Value
'    ColD = Cells(5, 4).Value
'    ColE = Cells(5, 5).Value
'    ColF = Cells(5, 6).Value
'    ColG = Cells(5, 7).Value
'    ColH = Cells(5, 8).Value
'    ColI = Cells(5, 9).Value
'    ColJ = Cells(5, 10).Value
'    ColK = Cells(5, 11).Value
'    ColL = Cells(5, 12).Value
'    ColM = Cells(5, 13).Value
'    ColN = Cells(5, 14).Value
'    ColO = Cells(5, 15).Value
'    ColP = Cells(5, 16).Value
'    ColQ = Cells(5, 17).Value
'    ColR = Cells(5, 18).Value
'    ColS = Cells(5, 19).Value
'    ColT = Cells(5, 20).Value
'    ColU = Cells(5, 21).Value
'    ColV = Cells(5, 22).Value
       
    ' load the header into a variant array
    Set rng = Range("Raw_Data_Headers") 'You only need the headers and not all the table
   
    'variable used to filter data
    LookCol = Cells(2, 2).Value
   
    LookCnum = Application.WorksheetFunction.Match(LookCol, rng, 0)
   
 '   LookCol = Split(Cells(1, LookCnum).Address, "$")(1)
   
    'looking for column numbers
    For i = 1 To 22
     row5col(i) = Application.WorksheetFunction.Match(row5values(1, i), rng, 0)
    Next i
    'CnumA = Application.WorksheetFunction.Match(ColA, rng, 0)
    'CnumB = Application.WorksheetFunction.Match(ColB, rng, 0)
    'CnumC = Application.WorksheetFunction.Match(ColC, rng, 0)
    'CnumD = Application.WorksheetFunction.Match(ColD, rng, 0)
    'CnumE = Application.WorksheetFunction.Match(ColE, rng, 0)
    'CnumF = Application.WorksheetFunction.Match(ColF, rng, 0)
    'CnumG = Application.WorksheetFunction.Match(ColG, rng, 0)
    'CnumH = Application.WorksheetFunction.Match(ColH, rng, 0)
    'CnumI = Application.WorksheetFunction.Match(ColI, rng, 0)
    'CnumJ = Application.WorksheetFunction.Match(ColJ, rng, 0)
    'CnumK = Application.WorksheetFunction.Match(ColK, rng, 0)
    'CnumL = Application.WorksheetFunction.Match(ColL, rng, 0)
    'CnumM = Application.WorksheetFunction.Match(ColM, rng, 0)
    'CnumN = Application.WorksheetFunction.Match(ColN, rng, 0)
    'CnumO = Application.WorksheetFunction.Match(ColO, rng, 0)
    'CnumP = Application.WorksheetFunction.Match(ColP, rng, 0)
    'CnumQ = Application.WorksheetFunction.Match(ColQ, rng, 0)
    'CnumR = Application.WorksheetFunction.Match(ColR, rng, 0)
    'CnumS = Application.WorksheetFunction.Match(ColS, rng, 0)
    'CnumT = Application.WorksheetFunction.Match(ColT, rng, 0)
    'CnumU = Application.WorksheetFunction.Match(ColU, rng, 0)
    'CnumV = Application.WorksheetFunction.Match(ColV, rng, 0)
   
       
    'Convert To Column Letter
    'ColA = Split(Cells(1, CnumA).Address, "$")(1)
    'ColB = Split(Cells(1, CnumB).Address, "$")(1)
    'ColC = Split(Cells(1, CnumC).Address, "$")(1)
    'ColD = Split(Cells(1, CnumD).Address, "$")(1)
    'ColE = Split(Cells(1, CnumE).Address, "$")(1)
    'ColF = Split(Cells(1, CnumF).Address, "$")(1)
    'ColG = Split(Cells(1, CnumG).Address, "$")(1)
    'ColH = Split(Cells(1, CnumH).Address, "$")(1)
    'ColI = Split(Cells(1, CnumI).Address, "$")(1)
    'ColJ = Split(Cells(1, CnumJ).Address, "$")(1)
    'ColK = Split(Cells(1, CnumK).Address, "$")(1)
    'ColL = Split(Cells(1, CnumL).Address, "$")(1)
    'ColM = Split(Cells(1, CnumM).Address, "$")(1)
    'ColN = Split(Cells(1, CnumN).Address, "$")(1)
    'ColO = Split(Cells(1, CnumO).Address, "$")(1)
    'ColP = Split(Cells(1, CnumP).Address, "$")(1)
    'ColQ = Split(Cells(1, CnumQ).Address, "$")(1)
    'ColR = Split(Cells(1, CnumR).Address, "$")(1)
    'ColS = Split(Cells(1, CnumS).Address, "$")(1)
    'ColT = Split(Cells(1, CnumT).Address, "$")(1)
    'ColU = Split(Cells(1, CnumU).Address, "$")(1)
    'ColV = Split(Cells(1, CnumV).Address, "$")(1)
 
    frow = wSht.Range("V" & Rows.Count).End(xlUp).Row
   
    For i = 2 To frow
        If wSht.Range(LookCol & i) = searchCode Then
             For j = 1 To 22
               wThis.Range(Cells(crow, j), Cells(crow, j)) = wSht.Range(Cells(i, row5col(j)), Cells(i, row5col(j)))
             Next j
        
'            wThis.Range("A" & crow) = wSht.Range(ColA & i)
'            wThis.Range("B" & crow) = wSht.Range(ColB & i)
'            wThis.Range("C" & crow) = wSht.Range(ColC & i)
'            wThis.Range("d" & crow) = wSht.Range(ColD & i)
'            wThis.Range("e" & crow) = wSht.Range(ColE & i)
'            wThis.Range("f" & crow) = wSht.Range(ColF & i)
'            wThis.Range("g" & crow) = wSht.Range(ColG & i)
'            wThis.Range("h" & crow) = wSht.Range(ColH & i)
'            wThis.Range("i" & crow) = wSht.Range(ColI & i)
'            wThis.Range("j" & crow) = wSht.Range(ColJ & i)
'            wThis.Range("k" & crow) = wSht.Range(ColK & i)
'            wThis.Range("l" & crow) = wSht.Range(ColL & i)
'            wThis.Range("m" & crow) = wSht.Range(ColM & i)
'            wThis.Range("n" & crow) = wSht.Range(ColN & i)
'            wThis.Range("o" & crow) = wSht.Range(ColO & i)
'            wThis.Range("p" & crow) = wSht.Range(ColP & i)
'            wThis.Range("q" & crow) = wSht.Range(ColQ & i)
'            wThis.Range("r" & crow) = wSht.Range(ColR & i)
'            wThis.Range("S" & crow) = wSht.Range(ColS & i)
'            wThis.Range("T" & crow) = wSht.Range(ColT & i)
'            wThis.Range("U" & crow) = wSht.Range(ColU & i)
'            wThis.Range("V" & crow) = wSht.Range(ColV & i)
            crow = crow + 1
        End If
    Next i
End If
 
Upvote 0
offthelip said:
Your code is very long and inefficient, it will also be very slow because you are accessing the worksheet multiple times, it could be much more compact and much mcuh faster.
I have done some modifications to introduce the idea of using some basic arrays and doing a few thing in loops.
One really basic thing to learn is that although in EXCEL it uses letters for columns and number for rows, in VBA one can address cells using numbers for columns and rows. This means all your efforts to convert a number of a column to a letter is unnecessary . If you ever do need to find the letter of a column for column A to this equation works very well, It works by adding 64 to the number and then finding the ascii character that correspond:
tt= 4 ' i.e column D
colletter = Chr(64+tt)
I have commented out the unecessary code for half of it nad adding equivalent code ( but it is untested) . Note I have NOT made efforts to really speed up the code becuase that would make even more difficult to understand. This involves getting rid of all the refence to ranges and celsl and using variant arrays instead.
Finally you are saying you want to copy the colour of a cell using VBA. This is the real reason I decided to answer this query, because in a well designed system colour should be used to assist in dispaying the data, and conditional formatting can be useful in doing that. In a well designed VBA system Colour should never be used to "store" data or as a source of data. If it reflects some real world characteristic then it should be held as a data item in a separate coluimn. This is because dealing with colours in VBA is really quite complicated and it makes vBA really slow because colour can only be detected one cell at a time, while values can be read from the worksheet the entire sheet in one go.
Here is my updated code:
VBA Code: 
Sub Lookup()


Application.ScreenUpdating = False
Dim wSht As Worksheet, crow As Long, frow As Long, i As Long, wThis As Worksheet
Dim searchCode As String

Set wThis = Sheet1
searchCode = Trim(wThis.Range("B3"))
ActiveSheet.Unprotect
wThis.Range("A6:AL" & Rows.Count) = Empty

crow = 6
If Trim(wThis.Range("C3")) = "Y" Then
    Set wSht = Sheet2
    Dim rng As Range
      
  
    Dim LookCnum As Integer
  
  
    Dim LookCol As String
  
    row5values = Range(Cells(5, 1), Cells(5, 22)) ' this pick up all the values below in one line in an array
    Dim row5col(1 To 22) As Long   ' we use this array to store the column numbers a found in in raw data headers
   
'    ColA = Cells(5, 1).Value
'    ColB = Cells(5, 2).Value
'    ColC = Cells(5, 3).Value
'    ColD = Cells(5, 4).Value
'    ColE = Cells(5, 5).Value
'    ColF = Cells(5, 6).Value
'    ColG = Cells(5, 7).Value
'    ColH = Cells(5, 8).Value
'    ColI = Cells(5, 9).Value
'    ColJ = Cells(5, 10).Value
'    ColK = Cells(5, 11).Value
'    ColL = Cells(5, 12).Value
'    ColM = Cells(5, 13).Value
'    ColN = Cells(5, 14).Value
'    ColO = Cells(5, 15).Value
'    ColP = Cells(5, 16).Value
'    ColQ = Cells(5, 17).Value
'    ColR = Cells(5, 18).Value
'    ColS = Cells(5, 19).Value
'    ColT = Cells(5, 20).Value
'    ColU = Cells(5, 21).Value
'    ColV = Cells(5, 22).Value
      
    ' load the header into a variant array
    Set rng = Range("Raw_Data_Headers") 'You only need the headers and not all the table
  
    'variable used to filter data
    LookCol = Cells(2, 2).Value
  
    LookCnum = Application.WorksheetFunction.Match(LookCol, rng, 0)
  
'   LookCol = Split(Cells(1, LookCnum).Address, "$")(1)
  
    'looking for column numbers
    For i = 1 To 22
     row5col(i) = Application.WorksheetFunction.Match(row5values(1, i), rng, 0)
    Next i
    'CnumA = Application.WorksheetFunction.Match(ColA, rng, 0)
    'CnumB = Application.WorksheetFunction.Match(ColB, rng, 0)
    'CnumC = Application.WorksheetFunction.Match(ColC, rng, 0)
    'CnumD = Application.WorksheetFunction.Match(ColD, rng, 0)
    'CnumE = Application.WorksheetFunction.Match(ColE, rng, 0)
    'CnumF = Application.WorksheetFunction.Match(ColF, rng, 0)
    'CnumG = Application.WorksheetFunction.Match(ColG, rng, 0)
    'CnumH = Application.WorksheetFunction.Match(ColH, rng, 0)
    'CnumI = Application.WorksheetFunction.Match(ColI, rng, 0)
    'CnumJ = Application.WorksheetFunction.Match(ColJ, rng, 0)
    'CnumK = Application.WorksheetFunction.Match(ColK, rng, 0)
    'CnumL = Application.WorksheetFunction.Match(ColL, rng, 0)
    'CnumM = Application.WorksheetFunction.Match(ColM, rng, 0)
    'CnumN = Application.WorksheetFunction.Match(ColN, rng, 0)
    'CnumO = Application.WorksheetFunction.Match(ColO, rng, 0)
    'CnumP = Application.WorksheetFunction.Match(ColP, rng, 0)
    'CnumQ = Application.WorksheetFunction.Match(ColQ, rng, 0)
    'CnumR = Application.WorksheetFunction.Match(ColR, rng, 0)
    'CnumS = Application.WorksheetFunction.Match(ColS, rng, 0)
    'CnumT = Application.WorksheetFunction.Match(ColT, rng, 0)
    'CnumU = Application.WorksheetFunction.Match(ColU, rng, 0)
    'CnumV = Application.WorksheetFunction.Match(ColV, rng, 0)
  
      
    'Convert To Column Letter
    'ColA = Split(Cells(1, CnumA).Address, "$")(1)
    'ColB = Split(Cells(1, CnumB).Address, "$")(1)
    'ColC = Split(Cells(1, CnumC).Address, "$")(1)
    'ColD = Split(Cells(1, CnumD).Address, "$")(1)
    'ColE = Split(Cells(1, CnumE).Address, "$")(1)
    'ColF = Split(Cells(1, CnumF).Address, "$")(1)
    'ColG = Split(Cells(1, CnumG).Address, "$")(1)
    'ColH = Split(Cells(1, CnumH).Address, "$")(1)
    'ColI = Split(Cells(1, CnumI).Address, "$")(1)
    'ColJ = Split(Cells(1, CnumJ).Address, "$")(1)
    'ColK = Split(Cells(1, CnumK).Address, "$")(1)
    'ColL = Split(Cells(1, CnumL).Address, "$")(1)
    'ColM = Split(Cells(1, CnumM).Address, "$")(1)
    'ColN = Split(Cells(1, CnumN).Address, "$")(1)
    'ColO = Split(Cells(1, CnumO).Address, "$")(1)
    'ColP = Split(Cells(1, CnumP).Address, "$")(1)
    'ColQ = Split(Cells(1, CnumQ).Address, "$")(1)
    'ColR = Split(Cells(1, CnumR).Address, "$")(1)
    'ColS = Split(Cells(1, CnumS).Address, "$")(1)
    'ColT = Split(Cells(1, CnumT).Address, "$")(1)
    'ColU = Split(Cells(1, CnumU).Address, "$")(1)
    'ColV = Split(Cells(1, CnumV).Address, "$")(1)

    frow = wSht.Range("V" & Rows.Count).End(xlUp).Row
  
    For i = 2 To frow
        If wSht.Range(LookCol & i) = searchCode Then
             For j = 1 To 22
               wThis.Range(Cells(crow, j), Cells(crow, j)) = wSht.Range(Cells(i, row5col(j)), Cells(i, row5col(j)))
             Next j
       
'            wThis.Range("A" & crow) = wSht.Range(ColA & i)
'            wThis.Range("B" & crow) = wSht.Range(ColB & i)
'            wThis.Range("C" & crow) = wSht.Range(ColC & i)
'            wThis.Range("d" & crow) = wSht.Range(ColD & i)
'            wThis.Range("e" & crow) = wSht.Range(ColE & i)
'            wThis.Range("f" & crow) = wSht.Range(ColF & i)
'            wThis.Range("g" & crow) = wSht.Range(ColG & i)
'            wThis.Range("h" & crow) = wSht.Range(ColH & i)
'            wThis.Range("i" & crow) = wSht.Range(ColI & i)
'            wThis.Range("j" & crow) = wSht.Range(ColJ & i)
'            wThis.Range("k" & crow) = wSht.Range(ColK & i)
'            wThis.Range("l" & crow) = wSht.Range(ColL & i)
'            wThis.Range("m" & crow) = wSht.Range(ColM & i)
'            wThis.Range("n" & crow) = wSht.Range(ColN & i)
'            wThis.Range("o" & crow) = wSht.Range(ColO & i)
'            wThis.Range("p" & crow) = wSht.Range(ColP & i)
'            wThis.Range("q" & crow) = wSht.Range(ColQ & i)
'            wThis.Range("r" & crow) = wSht.Range(ColR & i)
'            wThis.Range("S" & crow) = wSht.Range(ColS & i)
'            wThis.Range("T" & crow) = wSht.Range(ColT & i)
'            wThis.Range("U" & crow) = wSht.Range(ColU & i)
'            wThis.Range("V" & crow) = wSht.Range(ColV & i)
            crow = crow + 1
        End If
    Next i
End If
Click to expand...
@offthelip Thank you for a detailed answer! really helpful and good to understand the color question could lead to issues in speed.

The reason for fulling the color also is because it gives people a visual of what has happened to a specific item in the cell, using a traffic light system.

I loaded the code into the sheet but I get a compile error "Variable not defined" for row5values = in this air go code:- row5values = Range(Cells(5, 1), Cells(5, 22)) ' this pick up all the values below in one line in an array.

I think that I have missed something.

Attached is the lookup screen and then a data page. Noting that the lookup starts with titles on line 5 but the data tabs are from line 1.

Thanks again for your help with this!
 

Attachments

  • Screenshot 2021-01-31 at 00.45.25.png
    Screenshot 2021-01-31 at 00.45.25.png
    77.5 KB · Views: 15
  • Screenshot 2021-01-31 at 00.45.05.png
    Screenshot 2021-01-31 at 00.45.05.png
    165.3 KB · Views: 15
Upvote 0
StillUnderstanding said:
@offthelip
The reason for fulling the color also is because it gives people a visual of what has happened to a specific item in the cell, using a traffic light system.
Click to expand...
This was exactly what I was talking about, if it is useful for the people to be able to see what the status of a record is , then this should be captured with a cell that records the status e.g. a drop down with the different status a record can be for example : ordered, in stock, outfor delivery, delivered, or whatever you are recording with the colours. Then you can use conditional formating to do the colouring.
I presume you must have option explicit, because of the variable not defined error. which means you must define the variable. Setting option explicit is supposed to be helpful in this case it doesn't seemed to have helped!! If you remove the option explicit declaration the line where the error is will go away and the excel will automatically define Row5values as a two dimensional variant array of dimensions 1 to 1 and 1 to 22.
If you want to retain the option explicit then you just need to define the variable as variant array e.g.
VBA Code: 
dim Row5values ()
 
Upvote 0
offthelip said:
This was exactly what I was talking about, if it is useful for the people to be able to see what the status of a record is , then this should be captured with a cell that records the status e.g. a drop down with the different status a record can be for example : ordered, in stock, outfor delivery, delivered, or whatever you are recording with the colours. Then you can use conditional formating to do the colouring.
I presume you must have option explicit, because of the variable not defined error. which means you must define the variable. Setting option explicit is supposed to be helpful in this case it doesn't seemed to have helped!! If you remove the option explicit declaration the line where the error is will go away and the excel will automatically define Row5values as a two dimensional variant array of dimensions 1 to 1 and 1 to 22.
If you want to retain the option explicit then you just need to define the variable as variant array e.g.
VBA Code: 
dim Row5values ()
Click to expand...
Thanks @offthelip for the reply.

I uploaded the file here Filebin :: bin galp3b1t6okktx0w after I loaded your code but. It won't work for me.

To expand on the color reasoning:- Each box is being used to indicate action taken on the contents of the cell, so if I have started the task that is mentioned in the cell then I will just change the color of the to Amber and once I have completed it then I would go back and mark it as Green. Changing the cell color is manual as I can't apply conditional formatting as we don't have strict rules around the content of the box.

Im not sure if you want to help with this anymore but I would be grateful if you would be willing.

Thanks!
 
Upvote 0
I downloaded your workbook: and you haven't even added the one line modfication that I suggested which is :
VBA Code: 
Dim row5values()
So I am not impressed! once I had corrected that one the same error comes up somewhere else , I will leave you to debug your code. Until you can debug these really simple errors you should just keep studying and reading up about VBA
 
Upvote 0
offthelip said:
I downloaded your workbook: and you haven't even added the one line modfication that I suggested which is :
VBA Code: 
Dim row5values()
So I am not impressed! once I had corrected that one the same error comes up somewhere else , I will leave you to debug your code. Until you can debug these really simple errors you should just keep studying and reading up about VBA
Click to expand...
Thanks. Im no expert, far from it :-( sadly i am reaching having to reach out for help because I can't fix it myself.

All self taught here and some of the (including debugging) is beyond my understanding.

As I said, thanks for your help with this.

Would welcome help from others in the forum to get this working.
 
Upvote 0
offthelip said:
once I had corrected that one the same error comes up somewhere else , I will leave you to debug your code.
Click to expand...
Both the undeclared variables are actually in your code not the OP's
offthelip said:
Until you can debug these really simple errors
Click to expand...
They maybe simple to some, but not to everybody, especially when it's your code that caused the error.
 
Upvote 0
@ fluff, :Very sorry
to get the code to run add these two lines to the top of the code:
VBA Code: 
Dim row5values()
Dim j As Long
 
Upvote 0
offthelip said:
@ fluff, :Very sorry
to get the code to run add these two lines to the top of the code:
VBA Code: 
Dim row5values()
Dim j As Long
Click to expand...
thanks again @offthelip for your help with this, I know it's frustrating having people ask questions that know very little about the subject mater in general. I feel like I am so close here.... can't see the wood for the trees... if you like.

I think I updated the line you said @offthehip and the code now looks like this with all the commented buts removed but I still get a compile error for End if without block if.

It should like you have got it working on your end? would it be too much to ask you to paste the full code from the workbook that is working for you? I understand if you don't want to and appreciate all your time thus far.

Thanks again.


VBA Code: 
Option Explicit
Option Compare Text
Sub Lookup()


Application.ScreenUpdating = False
Dim row5values()
Dim j As Long
Dim wSht As Worksheet, crow As Long, frow As Long, i As Long, wThis As Worksheet
Dim searchCode As String
  

Set wThis = Sheet1
searchCode = Trim(wThis.Range("B3"))
ActiveSheet.Unprotect
wThis.Range("A6:AL" & Rows.Count) = Empty

crow = 6
For Each wSht In ThisWorkbook.Worksheets
    Dim rng As Range
      
  
    Dim LookCnum As Integer
  
  
    Dim LookCol As String
  
    row5values = Range(Cells(5, 1), Cells(5, 22)) ' this pick up all the values below in one line in an array
    Dim row5col(1 To 22) As Long   ' we use this array to store the column numbers a found in in raw data headers
   

      
    ' load the header into a variant array
    Set rng = Range("Raw_Data_Headers") 'You only need the headers and not all the table
  
    'variable used to filter data
    LookCol = Cells(2, 2).Value
  
    LookCnum = Application.WorksheetFunction.Match(LookCol, rng, 0)
  
  
    'looking for column numbers
    For i = 1 To 22
     row5col(i) = Application.WorksheetFunction.Match(row5values(1, i), rng, 0)
    Next i



    frow = wSht.Range("V" & Rows.Count).End(xlUp).Row
  
    For i = 2 To frow
        If wSht.Range(LookCol & i) = searchCode Then
             For j = 1 To 22
               wThis.Range(Cells(crow, j), Cells(crow, j)) = wSht.Range(Cells(i, row5col(j)), Cells(i, row5col(j)))
             Next j
       

            crow = crow + 1
        End If
    Next i
End If

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Ignore worksheet on lookup
Replies
3
Views
544
Fluff
Fluff
S
  • Question Question
How to get VBA search to return the row of data if the last cell in the range has no data in it
Replies
1
Views
886
Saurabhj
Saurabhj
ChristineJ
  • Question Question
Function rather than macro to return cell references
Replies
3
Views
346
Micron
M
ChristineJ
  • Solved
Adapting code to return cell values rather than cell references
Replies
2
Views
378
ChristineJ
ChristineJ
B
  • Solved
Use Sheet1:D5 to find matching cell in Sheet2 Column A:A, and select cell (or row)
Replies
1
Views
408
brianv
B

Forum statistics

Threads
1,223,957
Messages
6,175,623
Members
452,661
Latest member
Nonhle

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