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 

• Mathieu Guindon: What's srccolbyname doing?
• Johnson Jason: added it per your request. It's just finding the col number for the matching col

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

• Johnson Jason: Thank you so much. Appreciate the detailed answer. The reason I was checking cell by cell is because the source page might not have the same cols and order of cols as the destination page. We need the ability for the user to add cols without breaking the VBA.
• Mathieu Guindon: Hmm this does change things. I've added a number of Rubberduck inspection results.