Copy and paste formatting is slow using VBA

Question

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

Answer 1

This:

If header = True Then: srcrow = 23: Else: srcrow = 24

Would be much better off as an IIf statement:

srcrow = IIf(header, 23, 24)

Also note, this:

If {boolean-expression} = True Then

..is always redundant and can be written as:

If {boolean-expression} Then

With header being a Boolean already, there's no need to compare it to a Boolean literal to obtain a {boolean-expression}!

---

One of the most important things to do when you have blocks in your code (If...End If, For...Next, While...Wend, Do...Loop, but also Sub...End Sub, etc.), is indentation.

Here's your function, properly indented:

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")
    srcrow = IIf(header, 23, 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

Notice how much easier it is to see where the loop starts, where it ends, and what's in its body.

Now sure what ZROW is, it's not declared in the scope of formatrow so I'm assuming it's a module-scoped constant and that other procedures in that module as using it. If only formatrow uses it, it should be scoped to formatrow.

You declared sht and sht2 as Worksheet objects; you should be querying the Worksheets collection, not Sheets (which contains charts and other sheet types).

But then, if these sheets aren't dynamically generated, you shouldn't need to query any worksheet collection and get the objects by their "sheet name" (which the users can change at any time!) - instead, use their "code name": VBA defines a global-scope object for every Excel object (including ThisWorkbook, but also Sheet1 and every sheet in the workbook), so you can use the Properties toolwindow (F4) to set their (Name) property to a meaningful identifier, and then use that identifier in code, so you can delete all these:

Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("DEALSHEET")
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Sheets("Sheet1")

And then do this (assuming the sheet labelled "DEALSHEET" is named DealSheet):

LastColumn = DealSheet.Cells(ZROW + 1, DealSheet.Columns.Count).End(xlToLeft).Column

And this:

headerval = DealSheet.Cells(ZROW + 1, x).Value

And that:

Sheet1.Cells(srcrow, srccol).Copy 'THIS IS SLOW

And so on.

---

Now, about performance. You need a radically different approach. How would you do it if you were going to do it manually? Would you Copy+Paste one cell at a time, or Copy+Paste the whole row at once?

You want to copy/paste the formats on srcrow from column 2 through LastColumn: do that.

Sheet1.Range(Sheet1.Cells(srcrow, 2), Sheet1.Cells(srcrow, LastColumn)).Copy
DealSheet.Range(DealSheet.Cells(roww, 2), DealSheet.Cells(roww, LastColumn)) _
         .PasteSpecial Paste:=xlPasteFormats, _
                       Operation:=xlNone, _
                       SkipBlanks:=False, _
                       Transpose:=False

No need to loop, no need to lookup column numbers. Unless I missed something. Should be much faster!

---

I also ran Rubberduck inspections (build 2.0.10, not released yet). A few things to note:

• formatrow is implicitly public. Consider specifying an explicit access modifier.
• sht, sht2, strng_name and x are poor names. Consider renaming them; avoid disemvoweling, numeric suffixes, underscores, type prefixes, and 1-2 character identifiers.
• formatrow is a Function, but its return value is never even assigned so it always returns an implicit Variant/Empty; it should probably be a Sub.
• Parameters roww, header, and strng_name are implicitly passed by reference, and can safely be passed by value (ByVal) instead.
• Explicit Call syntax is obsolete. Use the implicit call syntax instead (which you've used to call srccolbyname anyway).