CODEWITHSUNDEEP
vbaperformanceexcel
Johnson Jason
Johnson Jason

Reputation: 721

Copy and paste formatting is slow using VBA. How can I speed it up?

The following code is a function that works. It's just slow and I don't know how to speed it up. It takes an excel row number and the value of it's headerval (string) and finds the same headerval on a different sheet then copies the formatting and applies it to our new sheet. The true false is because the source sheet has 2 different formatting options. It passes in the row to use either 23 or 24. ZROW is a public variable which is set with the ROW to start looking. srccolbyname function gets a col number from the source sheet which has the same headerval

Function formatrow(roww As Long, header As Boolean)

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim headerval As String
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("DEALSHEET")
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Sheets("Sheet1")
If header = True Then: srcrow = 23: Else: srcrow = 24
LastColumn = sht.Cells(ZROW + 1, sht.Columns.Count).End(xlToLeft).Column

For x = 2 To LastColumn
headerval = sht.Cells(ZROW + 1, x).Value
srccol = srccolbyname(headerval)
sht2.Cells(srcrow, srccol).Copy 'THIS IS SLOW
sht.Cells(roww, x).PasteSpecial Paste:=xlPasteFormats,    Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next x

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


End Function

As requested here is the support function referenced above.

Public Function srccolbyname(strng_name As String) As Integer
Call findcol 'find ZROW
Dim x As Integer
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Sheet1")
LastColumn = sht.Cells(22, sht.Columns.Count).End(xlToLeft).Column
    For x = 2 To LastColumn
        chkval = sht.Cells(22, x).Value
            If Trim(UCase(chkval)) = Trim(UCase(strng_name)) Then
            srccolbyname = x
            Exit For
        Else
        srccolbyname = 2
        End If
    Next x
End Function

Upvotes: 2

Views: 9057

Answers (1)

kpg987
kpg987

Reputation: 486

There are numerous ways to make your code faster, but you'll find that the copy and paste special in particular is notoriously slow. Provided that the formatting you need to preserve is simply the cell value, background color and font color, you could try to replace

  sht2.Cells(srcrow, srccol).Copy 
  sht.Cells(roww, x).PasteSpecial Paste:=xlPasteFormats,    Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False

With this:

 sht2.Cells(srcrow,srcol).Value=sht.Cells(roww,x).Value
 sht2.Cells(srcrow,srcol).Interior.ColorIndex=sht.Cells(roww,x).Interior.ColorIndex
 sht2.Cells(srcrow,srcol).Font.ColorIndex=sht.Cells(roww,x).Font.ColorIndex

You'll find that people have looked into this issue on Stack Overflow before: fast way to copy formatting in excel

If your performance issues persist, I would look into replacing your user-defined function srccolbyname by the range.find method (see more about it here: https://msdn.microsoft.com/en-us/library/office/ff839746.aspx). It seems to me to be performing the same role as this inbuilt method. Typically, these inbuilt methods will run faster than a UDF.

In general, if possible it's better to refer to a range (i.e. a collection of cells) rather than cells individually. By copy-pasting a range rather than the cells one by one, you minimize the traffic (i.e. switching back and forth) between Excel and VBA which typically hampers performance.

Upvotes: 5

Related Questions