CODEWITHSUNDEEP
vbaexcel
Rui Costa
Rui Costa

Reputation: 65

copy/pastspecial cell format in VBA User-Defined Function

I have a formula in VBA that: - Executes VLOOKUP - Find the address of the cell that has the value found by vlookup - PROBLEM: Copy/pastespecial original cell's format - Return Value of vlookup

Function VLOOKUPnew(ValueToLook As Range, Interval As Range, ColIndex As Integer) As Variant

Dim fMatch, fVlookup

Dim ColMatchIndex
Dim CellOrigin, CellDestination

' ********************************************************************************
' LOOKUP:: Application.VLookup(ValueToLook, Interval, colIndex, False)
' MATCH:: Application.Match(ValueToLook, Range(Interval.Address()).Columns(1), 0)
' ********************************************************************************

' Indice da 1ª coluna do Intervalo
' **********************************************
ColMatchIndex = Interval.Columns(Interval.Columns.Count - 1).Column
' **********************************************

fMatch = Application.Match(ValueToLook, Range(Interval.Address()).Columns(1), 0)

' Obtem o endereço da célula que contem o valor do VLOOKUP
' **********************************************
CellOrigin = Interval.Cells(fMatch, Interval.Columns.Count).Address()
' **********************************************

' Copia a Formatação da Célula encontrada pelo Vlookup
' ******************************************************************
Range(CellOrigin).Copy
ActiveCell.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
' ******************************************************************

VLOOKUPnew = Application.VLookup(ValueToLook, Interval, ColIndex, False)
End Function

Some tips to keep in mind: - User must write function - VLOOKUPnew - like he writes normal vlookup formula at excel - After press enter, the function must return vlookupnew results his cell's format

Don't copy/paste cell's format. Any tip?

Printscreen of my goal Printscreen of excel

Upvotes: 2

Views: 1654

Answers (1)

A.S.H
A.S.H

Reputation: 29352

Well, we can't say we can't to the HR director, can we? :P Although it is not straightforward to do some operations such as copy/paste inside a custom User-Defined Function (UDF), it is still achievable in a tricky way, to some extent with a few limitations that I will point out at the end.

The code snippets that follow can be considered as a general technique to achieve any type of "forbidden UDF operations": memorize them somehow and let the Workbook_SheetCalculate event handler execute them later.

The idea is to count on the Workbook_SheetCalculate event, because we know that it will be invoked after the calculation is made, and unlike UDFs, it allows us to do copying and pasting. Therefore, the UDF will simply hand it the ranges (sources and destinations) through some variables. Once the calculation is made and the UDFs are finished, Workbook_SheetCalculate will be automatically invoked; it will read those variables and achieve the jobs that the UDF did not allow directly.

1) In code Module ThisWorkbook:

Public Sources As New Collection, Destinations As New Collection

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Application.ScreenUpdating = False
    On Error GoTo Cleanup
    For Each src In Sources
        src.copy
        Destinations(1).PasteSpecial xlPasteFormats
        Destinations.Remove 1
    Next

Cleanup:
    Application.CutCopyMode = False
    Set Sources = New Collection: Set Destinations = New Collection
    Application.ScreenUpdating = True
End Sub

2) In the User-Defined Function, instead of doing directly a copy/paste operation, add your source cell and your destination cell to the ThisWorkbook.Sources and ThisWorkbook.Destinations collections, respectively. That is, replace the following part of your UDF code:

Range(CellOrigin).Copy
ActiveCell.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False

with this:

ThisWorkbook.Sources.Add Range(CellOrigin)
ThisWorkbook.Destinations.Add Application.ThisCell

This will achieve the desired behavior. But as I said, There are a few limitations:

First, it's a bit slow if the number of cells that use your custom UDF is too big (say thousands).

Second and more important, automatic calculation in Excel is not triggered when you change a cell's format, but only when you change its value. Therefore, if the user changes the source cell's format but not its value, the format will not be immediately reported at the destination. The user will probably need to manually force the calculation, i.e. by pressing F9.

Upvotes: 3

Related Questions