Can VBA vlookup keep cell formatting?

[NewAtVba]

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.

 

[Rhinoman]

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.

         With .Font
            .ColorIndex = rSource.Font.ColorIndex
            .Bold = rSource.Font.Bold
         End With

Thanks Jerry. The code implements perfectly and I am able to see the VlookupFormat function in the workbook but could you please give me an example of how to use the syntax? I'm having some trouble with it. Say I wanted to take the formatting from Column E in the AB3 data row on tab D and apply it to the E column in the AB3 data row on tab A?

Thanks a lot!

 

[Jerry Sullivan]

Say I wanted to take the formatting from Column E in the AB3 data row on tab D and apply it to the E column in the AB3 data row on tab A?

The arguments would be exactly the same as if you were doing VLOOKUP.

In Sheet A, Cell E41 (the AB3 row), enter this formula:
=VlookupFormat($A41,D!$A:$E,5,0)

It will lookup the corresponding value of the AB3 row in Sheet D (Cell E38), and it will also apply the color of cell D!E8 to cell A!E41.

Btw, instead of hard coding the column number into a Vlookup formula for a multi-column table like this, it's usually better to reference a helper cells that hold column numbers. Use a formula like this above your table on Sheet A:

Book1
	D	E	F	G	H	I
1	4	5	6	7	8	9
A

Cell Formulas
Range	Formula
D1	=COLUMNS(D!$A$1:D$1)

Now enter this formula in Sheet A, Cell E41 (the AB3 row):
=VlookupFormat($A41,D!$A:$Z,E$1,0)

That formula can be copied across all the rows and columns of your table, and it automatically adjusts the column numbers if columns are inserted or deleted on Sheet D.

 

[timrose]

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...

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...

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)

Thank you very much for this code. Hopefully it will help us resolve an important requirement. However, I have a question. If I have a cell with the following call to this UDF, it works great when the referenced workbook File1.xlsm is already open.

=VlookupFormat(E$19, '[File1.xlsm]Sheet1'!$A$4:$AS$25, D74, FALSE)

However, neither of the following works when the workbook File1.xlsm is closed.

=VlookupFormat(E$19, '\\Server1\Share1\Folder1\[File1.xlsm]Sheet1'!$A$4:$AS$25, D74, FALSE)
=VlookupFormat(E$19, 'X:\Folder1\[File1.xlsm]Sheet1'!$A$4:$AS$25, D74, FALSE)

Yet both of the following work in getting just the value when the workbook File1.xlsm is closed.

=VLOOKUP(E$19, '\\Server1\Share1\Folder1\[File1.xlsm]Sheet1'!$A$4:$AS$25, D74, FALSE)
=VLOOKUP(E$19, 'X:\Folder1\[File1.xlsm]Sheet1'!$A$4:$AS$25, D74, FALSE)

Is there something that can be modified in your code to allow it to work, as the built-in function VLOOKUP does, when the referenced workbook (File1.xlsm) is closed? Thank you.

 

[waynestemp]

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...

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...

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)

I understand that this forum thread is old, but I am hoping someone can assist further.

I am dealing with a report that has a column using a list from the validation function. There are multiple vlookup formulas that are referencing the value from the list, however the source value have multiple number formats (percentages, numbers with decimals, numbers without decimals, custom formats). Is there something that can be added in the ThisWorkBook portion of the above VBA code that works with number formats?

Thank you for any assistance.