Can VBA vlookup keep cell formatting?

N

NewAtVba

New Member
Joined
Jun 1, 2011
Messages
16
Hi, i posted this thread yesterday http://www.mrexcel.com/forum/showthread.php?t=554056 on making my filename dynamic. The solution worked great. I'm now looking to improve on the code and keep the cell formatting of the 4 columns that are being looked up.

This is the current code.


Sub Macro2()
'
' Macro2 Macro
'

'
Application.ScreenUpdating = False
Dim Bottom As Long
Bottom = Range("A65536").End(xlUp).Row

Range("r2").Select
ActiveCell.Formula = "=VLOOKUP($A2,'[" & Range("X3").Value & "]Sheet1'!$A$1:$T$" & Bottom & ",17,0)"
Selection.AutoFill Destination:=Range("r2:r" & Bottom)

Range("s2").Select
ActiveCell.Formula = "=VLOOKUP($A2,'[" & Range("X3").Value & "]Sheet1'!$A$1:$t$" & Bottom & ",18,0)"
Selection.AutoFill Destination:=Range("s2:s" & Bottom)

Range("t2").Select
ActiveCell.Formula = "=VLOOKUP($A2,'[" & Range("X3").Value & "]Sheet1'!$A$1:$t$" & Bottom & ",19,0)"
Selection.AutoFill Destination:=Range("t2:t" & Bottom)

Range("u2").Select
ActiveCell.Formula = "=VLOOKUP($A2,'[" & Range("X3").Value & "]Sheet1'!$A$1:$t$" & Bottom & ",20,0)"
Selection.AutoFill Destination:=Range("u2:u" & Bottom)

End Sub

Cell X3 contains the filename "Master Copy.xlsx".
Any solutions will be greatly appreciated.:)
 
Sort by date Sort by votes
If you want each cell to match the formatting of its match in the source file, this should work...

Code: 
Sub Vlookup_Copy_Formats_by_Cell()
    Dim lngBottom As Long, i As Long
    Dim strMasterFile As String
    Dim varIDs As Variant
    Dim c As Range
    Application.ScreenUpdating = False
 
    With ActiveSheet
        strMasterFile = .Range("X3").value
        lngBottom = .Range("A" & .Rows.Count).End(xlUp).row
        varIDs = .Range("A2:A" & lngBottom)
    End With
 
    With Workbooks(strMasterFile).Sheets("Sheet1")
        For i = LBound(varIDs) To UBound(varIDs)
            Set c = .Columns("A").Find(What:=varIDs(i, 1), _
                After:=.Range("A1"), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchDirection:=xlNext)
            If c Is Nothing Then
                ActiveSheet.Cells(i + 1, 18).Resize(1, 4).value = "#N/A"
            Else
                c.Resize(1, 4).Offset(0, 16).Copy _
                    Destination:=ActiveSheet.Cells(i + 1, 18)
            End If
        Next i
    End With
End Sub

Please let me know if that is what you were after.
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
wQjI6.jpg


Here you go. the fields that return 0 should remain unformatted. Is there a way to make the zeros empty cells?

thanks for your patience
 
Upvote 0
Hey, sorry for doing an extra post. I just saw your last post before i replied with the picture. i just tried out the latest code and it works!!

Thank you so much:):)
 
Upvote 0
Glad that helped. Good luck with learning VBA!
What will you do with your screen name when you become an expert? :biggrin:
 
Upvote 0
Hello, I am new here. Your VBA above seemed to work for someone else, but I can't get it to work for me. I am running Excel for Mac 2011.

I already have my VLOOKUP (with an imbedded MATCH function) built in a sheet. The VLOOKUP calls text from another sheet which is font color formatted depending on user decision. I want the VLOOKUP to return the source formatting as well as the text. I am new-er to VBA but have some of the basics figured out. Can you help?

Thanks!
 
Upvote 0
Hi ClareG, The code example above was tailored to a specific scenario. There isn't any code in there that won't work on Mac, but it's not surprising that you had trouble adapting it to your setup if you are new-er to VBA.

If you'll provide specific details about your setup (Sheets, Ranges, formulas relevant to the task), I'll try to help with a modified version.
 
Upvote 0
The code equation that I am using is =VLOOKUP($A9,Raw_Database!$A$1:$BM$85,MATCH($A$1,Raw_Database!$A$1:$BM$1,0),FALSE)

I would like that formula to retain it's font color formatting.

As a work around, I am using:
Sub Recalculate()
Code: 
'
' Recalculate Macro
'


'
    Range("H86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("I86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("J86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("K86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("L86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("M86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("N86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("o86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("p86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("q86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("r86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("s86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("t86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("u86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("v86").Select
      ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("w86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("x86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("y86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("z86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("aa86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ab86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ac86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ad86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ae86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("af86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ag86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ah86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ai86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("aj86").Select
        ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("Ak86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("al86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("am86").Select
      ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("an86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ao86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ap86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("aq86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ar86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("as86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("at86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("au86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("av86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("aw86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ax86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ay86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("az86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("ba86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bb86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bc86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bd86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("be86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bf86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bg86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bh86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bi86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bj86").Select
        ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bk86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bl86").Select
    ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
    Range("bm86").Select
      ActiveCell.FormulaR1C1 = _
        "=(COUNTA(Vessel_Name)-CountColor(R[-84]C:R[-1]C,R1C66))/COUNTA(Vessel_Name)"
        
End Sub
Which is annoying because it is a sequential range and I feel like I should be able to just list the range and not select each cell. And now I have to build the same macro for another set of data (column this time).

Any suggestions would be helpful. Thanks!
 
Upvote 0
Here's a User Defined Function (UDF) that you could try.

UDF's can't directly change cell formatting. The code below employs a clever workaround that Mike Erickson has shared.
The UDF places items in two Collections having Global scope, then the Workbook_SheetCalculate event uses those stored items to change the formatting.

To setup, Paste this code into the ThisWorkBook module of your workbook...

Code: 
Public FormatSource As New Collection
Public FormatTarget As New Collection

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
   Dim rSource As Range, rOneTarget As Range

   On Error GoTo Reset
   
   For Each rOneTarget In FormatTarget
      Set rSource = FormatSource(rOneTarget.Address(, , , True))
      
      With rOneTarget
         With .Interior
            .ColorIndex = rSource.Interior.ColorIndex
         End With
         
         With .Font
            .ColorIndex = rSource.Font.ColorIndex
            .Bold = rSource.Font.Bold
         End With
      End With
   Next rOneTarget

Reset:
   Set ThisWorkbook.FormatSource = New Collection
   Set ThisWorkbook.FormatTarget = New Collection

End Sub

Paste this code into a Standard Code Module in your workbook...
Code: 
Function VlookupFormat(sLookupValue As String, rTableRange As Range, _
   iColIndexNum As Long, Optional bRangeLookup = True) As Variant
   
Dim cThisCell As Range, cFound As Range
Dim vRow As Variant

Application.Volatile '--optional

On Error GoTo ErrorValue
If rTableRange.Columns.Count < iColIndexNum Then
    VlookupFormat = CVErr(xlErrRef)
    Exit Function
End If

With Application
   Set cThisCell = Application.Caller

   vRow = .Match(sLookupValue, .Index(rTableRange, 0, 1), _
      bRangeLookup)

   If IsError(vRow) Then
      VlookupFormat = CVErr(xlErrNA)
   Else
      Set cFound = .Index(rTableRange, vRow, _
         iColIndexNum)
      VlookupFormat = cFound.Value
      ThisWorkbook.FormatTarget.Add Item:=cThisCell, _
         Key:=cThisCell.Address(, , , True)
      ThisWorkbook.FormatSource.Add Item:=cFound, _
         Key:=cThisCell.Address(, , , True)
   End If
End With
Exit Function
ErrorValue:
    VlookupFormat = CVErr(xlErrValue)
End Function

With that UDF setup, you can use the VlookupFormat function as a custom worksheet function.

The code will lookup the value and also apply the Font Color, Font Bold and Interior Color from the found cell to the cell with the VlookupFormat formula.

Syntax Examples:
=VlookupFormat($A2, $C$2:$D$100, False)

=VlookupFormat($A9,Raw_Database!$A$1:$BM$85,MATCH($A$1,Raw_Database!$A$1:$BM$1,0),FALSE)
 
Upvote 0
I'm hoping to review this thread a bit for my specific application. I'm also new to VBA and need to retain source formatting (well only cell fill colour actually) when using vlookup to bring cell values (and fill colour) from one worksheet to another in the same workbook.

Specifically the area in red below I am bringing from tab 'D' to tab 'A' on a regular basis. The complication is that what I import to 'D' will not always be the exact same in terms of what row the data is in (AB1, AB2, etc.). This is why I need the vlookup function. The columns, fortunately, are static so I'm always pulling data from columns D:G and placing them in columns E:H but the rows may change.

I hope I explained this well.

Thanks you for any help!

Source.jpg
[/URL][/IMG]
DEST.jpg
[/URL][/IMG]
 
Last edited:
Upvote 0
Hi Rhinoman,

Have you tried the code in Post #18? It should do what you describe without the need for any modifications.

You could delete these rows if you don't want or need the font color and bold state to be copied.

Code: 
         With .Font
            .ColorIndex = rSource.Font.ColorIndex
            .Bold = rSource.Font.Bold
         End With
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Rename a Sheet
Replies
2
Views
156
Peter_SSs
Peter_SSs
P
  • Question
Help with Vba Code
Replies
3
Views
202
Coyotex3
C
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
1K
Joe4
Joe4
S
  • Solved
Copy row 2 and paste it after last row of another worksheet
Replies
9
Views
907
rollis13
rollis13
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
365
RoryA
RoryA

Forum statistics

Threads
1,215,766
Messages
6,126,754
Members
449,336
Latest member
p17tootie

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