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:
Sort by date Sort by votes
Can You explain in words what you are trying to do with this macro,
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
offthelip said:
Can You explain in words what you are trying to do with this macro,
Click to expand...
Sure.

I am looking to create 2 tabs per week (Listed as Raw Data on the book I uploaded), for example 01 feb 21 A and 01 Feb 21 B. The weekly tabs will have data starting at row 6 and the headers (in row 5) will be the same every week.

The weekly tabs will allow us to track our activity, so each cell will have a number of different items, when we start ,complete or have an issue with any of the items we will then mark them red, Amber or Green. So that overs off the weekly tabs.

Now for the lookup. I want people to be able to see the status of the items being completed, so in cell B2 they will state the header they are wanting the status for and in B3 they will state the criteria. So for example I want to know the Delivery Day of Apples (B2) and (B3) that matches this text “Wednesday”.

When I press search it will look at every sheet and for every sheet that matches (B2 and B3) it will then bring back the stated columns that are in row 5.

To answer your question about why rows are defined in the VBA, this was done because we don’t want to search every row, just the ones stated and as such it wont pull 100% of the row data back. Put another way, if the marching row has 30 cells of data I may only ever want 10 of that coming back. A,B,D,E,H,I,K,L as an example.

Ultimately the weekly tabs are for the workers and the lookup tab is for the managers to review the status of the tasks the works are doing.

I hope that helps?
 
Upvote 0
So If I have understood this; B2 contains the header which is one the cells containing the text in row 1 of "raw data" sheet , you want to select this column then to the search down this column and bring back every row that has a match with the text value which is in B3. and then display this data on the "lookup" sheet and also copy the colour across. I rpesume you want this in the column with the same header. Do you want the other columns to be blank?? If they aren't what dat should be in them??
I notice on the raw data sheet that the headers in row 5 are identical to the headers in row 1 of the raw data sheet, is this always the case, or does the order of the headers vary from one sheet to another. Because your code seems to trying to do something like that. If they are always the same them it makes it very easy. An alternative would be to copy the headers from the raw data sheet.
 
Upvote 0
Yes @offthelip you are correct in the first part.

For the second part, the headers are intentionally the samebut, as I have discovered, the sheet is not checking that the headers match for each row it is pulling back. This is a bit of a pain but I can work round it.
 
Upvote 0
So would a good way to do this is to find the column which matches the value in B2 then Filter onthe value in B3 in that column and then copy and paste the visible rows to the lookup sheet?
 
Upvote 0
Thats one way to do it, the problem is if you don't want to return days from a specific column.

To the original point, I think I have managed to get some help to get the colors working as expected within the confines of the original sheet.

Its not perfect in how the VBA is designed but it works to a point.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Ignore worksheet on lookup
Replies
3
Views
442
Fluff
Fluff
S
  • 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
714
Saurabhj
Saurabhj
ChristineJ
  • Solved
Adapting code to return cell values rather than cell references
Replies
2
Views
132
ChristineJ
ChristineJ
I
  • Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
93
irishjsk
I
Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
216
bobsan42
bobsan42

Forum statistics

Threads
1,214,827
Messages
6,121,824
Members
449,050
Latest member
Bradel

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