Note: The other languages of the website are Google-translated. Back to English
English English
  • Documents
  • Excel
  • How to vlookup and return background color along with the lookup value in Excel?

How to vlookup and return background color along with the lookup value in Excel?

Supposing you have a table as below screenshot shown. Now you want to check if a specified value is in column A and then return corresponding value along with background color in column C. How to achieve it? The method in the article can help you solve the problem.

Vlookup and return background color with lookup value by User-defined function


Vlookup and return background color with lookup value by User-defined function

Please do as follows to lookup a value and return its corresponding value along with background color in Excel.

1. In the worksheet contains the value you want to vlookup, right-click the sheet tab and select View Code from the context menu. See screenshot:

2. In the opening Microsoft Visual Basic for Applications window, please copy below VBA code into the Code window.

VBA code 1: Vlookup and return background color with the lookup value

Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xKeys As Long
    Dim xDicStr As String
    On Error Resume Next
    Application.ScreenUpdating = False
    xKeys = UBound(xDic.Keys)
    If xKeys >= 0 Then
        For I = 0 To UBound(xDic.Keys)
            xDicStr = xDic.Items(I)
            If xDicStr <> "" Then
                Range(xDic.Keys(I)).Interior.Color = _
                Range(xDic.Items(I)).Interior.Color
            Else
                Range(xDic.Keys(I)).Interior.Color = xlNone
            End If
        Next
        Set xDic = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

3. Then click Insert > Module, and copy the below VBA code 2 into the Module window.

VBA code 2: Vlookup and return background color with the lookup value

Public xDic As New Dictionary
Function LookupKeepColor (ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
    Dim xFindCell As Range
    On Error Resume Next
    Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
    If xFindCell Is Nothing Then
        LookupKeepColor = ""
        xDic.Add Application.Caller.Address, ""
    Else
        LookupKeepColor = xFindCell.Offset(0, xCol - 1).Value
        xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address
    End If
End Function

4. After inserting the two codes, then click Tools > References. Then check the Microsoft Script Runtime box in the References – VBAProject dialog box. See screenshot:

5. Press the Alt + Q keys to exit the Microsoft Visual Basic for Applications window and go back to the worksheet.

6. Select a blank cell adjacent to the lookup value, and then enter formula =LookupKeepColor(E2,$A$1:$C$8,3) into the Formula Bar, and then press the Enter key.

Note: In the formula, E2 contains the value you will lookup, $A$1:$C$8 is the table range, and number 3 means that the corresponding value you will return locates in the third column of the table. Please change them as you need.

7. Keep selecting the first result cell, and drag the Fill Handle down to get all results along with their background color. See screenshot.


Related articles:


The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by
80%

  • Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
  • Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
  • Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
  • Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
  • Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
  • Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
  • Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
  • Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
  • More than
    300
    powerful features
    . Supports Office/Excel
    2007-2019 and 365
    . Supports all languages. Easy deploying in your enterprise or organization. Full features
    30
    -day free trial. 60-day money back guarantee.
kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by
    50%
    , and reduces hundreds of mouse clicks for you every day!
officetab bottom
Comments (32)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
How do I change this code, in order for it to extract the background color from another sheet?
For example, I would like to use a VLOOKUP in Sheet 2, which extracts the data and background color from Sheet 1.
This comment was minimized by the moderator on the site
I have this exact same question! Any advice would be greatly appreciated.
This comment was minimized by the moderator on the site
I would also like to VLOOKUP on sheet 2 and extract the data and background color from sheet 1
This comment was minimized by the moderator on the site
Use this slight modification of the code posted.


Public xDic As New Dictionary
Public strWB As String
Public strWS As String

Function CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell As Range
On Error Resume Next

strWB = LookupRng.Parent.Parent.Name '*** Remember the Workbook where the data and color are coming from
strWS = LookupRng.Parent.Name '*** Remember the Worksheet where the data and color are coming from

Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

If xFindCell Is Nothing Then
CLookup = ""
xDic.Add Application.Caller.Address, ""
Else
CLookup = xFindCell.Offset(0, xCol - 1).Value
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address

End If
End Function

Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xKeys As Long
Dim xDicStr As String
Dim rngLoc As Range
On Error Resume Next
Application.ScreenUpdating = False
xKeys = UBound(xDic.Keys)
If xKeys >= 0 Then
For I = 0 To UBound(xDic.Keys)
xDicStr = xDic.Items(I)
If xDicStr <> "" Then
Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
Else
Range(xDic.Keys(I)).Interior.Color = xlNone
End If
Next
Set xDic = Nothing
End If
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
It this to fix an error in the original code or is this to allow it to look up from a different sheet?
This comment was minimized by the moderator on the site
This change to the original code allows you to do the vlookup w/color from one Worksheet to another or from one Workbook to another. But this code needs to be placed in the TARGET worksheet rather than the SOURCE worksheet as was described in the original code. That's because the original code only worked in one Worksheet, so it was both the Source and the Target. This is not a fix to the original code. I just added code to allow you to pull from any Workbook/Worksheet (Source) into your Worksheet (Target). The original code worked as the programmer intended.
This comment was minimized by the moderator on the site
hello I didi it the procedure but i cant bring the background color in the new worksheet , i have a doubt if i put in correct way the comand strWB and strWS i puted this strWB = LookupRng.Reporte_Opcionales
strWS = LookupRng.Imprimir Reporte_Opcionales is the name of my workbook
This comment was minimized by the moderator on the site
I believe the lines are supposed to be the following (EXACTLY):

strWB = LookupRng.Parent.Parent.Name

strWS = LookupRng.Parent.Name


I came up with this about 4 months ago so I don't remember exactly how I came up with this, but you weren't supposed to replace this code with anything else.
This comment was minimized by the moderator on the site
what the name in strWB has repeated Parent.Parent ???? does that correct?
thanks in advance.
This comment was minimized by the moderator on the site
Bob, help me plese , colud you please check the code? im sure that you can fix it because it does brigme the background color from other sheet .

by the way the code that is for work in the same sheet work but i need bring the data from other sheet :(.

thanks in advance
greetengs from Monterrey México.
This comment was minimized by the moderator on the site
This works great, thank you!
Rated 5 out of 5
This comment was minimized by the moderator on the site
this code working on same sheet, how can i look up color from one sheet to another?
This comment was minimized by the moderator on the site
Use this slight modification of the code posted.


Public xDic As New Dictionary
Public strWB As String
Public strWS As String

Function CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell As Range
On Error Resume Next

strWB = LookupRng.Parent.Parent.Name '*** Remember the Workbook where the data and color are coming from
strWS = LookupRng.Parent.Name '*** Remember the Worksheet where the data and color are coming from

Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

If xFindCell Is Nothing Then
CLookup = ""
xDic.Add Application.Caller.Address, ""
Else
CLookup = xFindCell.Offset(0, xCol - 1).Value
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address

End If
End Function

Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xKeys As Long
Dim xDicStr As String
Dim rngLoc As Range
On Error Resume Next
Application.ScreenUpdating = False
xKeys = UBound(xDic.Keys)
If xKeys >= 0 Then
For I = 0 To UBound(xDic.Keys)
xDicStr = xDic.Items(I)
If xDicStr <> "" Then
Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
Else
Range(xDic.Keys(I)).Interior.Color = xlNone
End If
Next
Set xDic = Nothing
End If
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Hello Bob! The code works, however, for some reason it copies values from Sheet 2 to Sheet 1, but copies the cell formatting and leaves it in Sheet 2... It's hard to explain, but it basically splits one action (copy text + copy formation and paste it into the cell) into two. Do you know how to make it to do both on one sheet? Thank you!
This comment was minimized by the moderator on the site
this code is running on same sheet but how can I lookup cell color from one sheet to another sheet in excel
Thanks in advance :)
This comment was minimized by the moderator on the site
Use this slight modification of the code posted.


Public xDic As New Dictionary
Public strWB As String
Public strWS As String

Function CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell As Range
On Error Resume Next

strWB = LookupRng.Parent.Parent.Name '*** Remember the Workbook where the data and color are coming from
strWS = LookupRng.Parent.Name '*** Remember the Worksheet where the data and color are coming from

Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

If xFindCell Is Nothing Then
CLookup = ""
xDic.Add Application.Caller.Address, ""
Else
CLookup = xFindCell.Offset(0, xCol - 1).Value
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address

End If
End Function

Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xKeys As Long
Dim xDicStr As String
Dim rngLoc As Range
On Error Resume Next
Application.ScreenUpdating = False
xKeys = UBound(xDic.Keys)
If xKeys >= 0 Then
For I = 0 To UBound(xDic.Keys)
xDicStr = xDic.Items(I)
If xDicStr <> "" Then
Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
Else
Range(xDic.Keys(I)).Interior.Color = xlNone
End If
Next
Set xDic = Nothing
End If
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
I have windows for Mac , when I get to Step 4 - there is no option for Microsoft Scripting Runtime, is there something else I should be selecting?
This comment was minimized by the moderator on the site
When I open the View Code window, there is a window but is not empty. Can I paste the code under the text that is already there or how do I open a new "blank page" please?
This comment was minimized by the moderator on the site
I am returning a value, but not getting the color. used the sheet to sheet code, followed to a T. Any ideas on why I am not getting the color?
This comment was minimized by the moderator on the site
Is there any way to modify this to use as an Hlookup?
This comment was minimized by the moderator on the site
good afternoon bob to these codes you can change them in addition to the color call me the same color format and font that contains the cell

Thank you
This comment was minimized by the moderator on the site
this works fine in office 2010, but not the 2013 version. Is there an update to the macro?
This comment was minimized by the moderator on the site
Hi, Can i apply vlookup on color cells with no data in them
This comment was minimized by the moderator on the site
i am getting the required cell color but i also need the lookup value as it is returning integer instead of string
This comment was minimized by the moderator on the site
I have used this in Excel 2016 and only the data is transferred from Source to Target...….color is not transferred. Thoughts on what issue might be: Is it incompatibility with Excel 2016? Thanks. MT
This comment was minimized by the moderator on the site
This was AWESOME! followed the steps and it works beautifully! Thank you!
This comment was minimized by the moderator on the site
I have many records, it takes too long to process, and the code keeps on running even after completion. Please help
This comment was minimized by the moderator on the site
Hello, i have a sheet with 10,948 rows, its taking some time to pull the information with colors, still waiting. Is this normal, or there is something wrong?
This comment was minimized by the moderator on the site
How I do
This comment was minimized by the moderator on the site
I use times and dates from excel reports to create timesheets for our employees. If the specified date, for example, 2020/08/11 matches the date on the next tabs array (which contains many cells with the same date but different times) I want it to pull only the cell filled in orange which will be stated as 2020/08/11 7:45. Is this possible?
This comment was minimized by the moderator on the site
Hi, Is this code working for office 2016 and later versions ?
This comment was minimized by the moderator on the site
no its not returning color.
There are no comments posted here yet
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations

Follow Us

Copyright © 2009 - www.extendoffice.com. | All rights reserved. Powered by ExtendOffice. | Sitemap
Microsoft and the Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries.
Protected by Sectigo SSL