# Copy and paste formatting is slow using VBA

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

• What's srccolbyname doing? Oct 20, 2016 at 18:56
• added it per your request. It's just finding the col number for the matching col Oct 20, 2016 at 19:12

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.

Function formatrow(roww As Long, header As Boolean)

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("DEALSHEET")
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Sheets("Sheet1")
LastColumn = sht.Cells(ZROW + 1, sht.Columns.Count).End(xlToLeft).Column

For x = 2 To LastColumn
headerval = sht.Cells(ZROW + 1, x).Value
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).
• 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. Oct 20, 2016 at 19:21
• Hmm this does change things. I've added a number of Rubberduck inspection results. Oct 20, 2016 at 19:33