StillUnderstanding
Board Regular
- Joined
- Jan 30, 2021
- Messages
- 80
- Office Version
- 365
- Platform
- Windows
- 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
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: