HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Merging worksheets and using find/replace

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
mergingandreplaceusingfindworksheets

Problem

Of all the macros that I put into heavy rotation these days, this one is running the slowest. ~4-5 seconds depending on the size of the files. It's not a lot but I'd like to know why code 16x as long is running much more instantly.

The code tries to merge documents (usually 2 excel docs out of at most 5) depending on their names and then rename those to exactly what I need. Then, another big issue, is using find/replace to fix a bunch of Unicode/character issues. I cant help but think that could be handled better.

I'd like to find out where the bottlenecks in this code are, how to handle these Unicode issues, perform the Find/replace better, and all in all how to execute better VBA practices.

```
Option Explicit
Sub MergeBooks()
Dim wb As Workbook
Dim ws As Worksheet

On Error GoTo Handler:
Application.ScreenUpdating = False
For Each wb In Application.Workbooks
If wb.Name <> "CompanyBook.xlsm" Then
If FindString(wb.Name, "Report2") Then
wb.Worksheets.Move after:=Workbooks("CompanyBook.xlsm").Sheets("Aggregate")
ElseIf FindString(wb.Name, "Report1") Then
wb.Worksheets.Move after:=Workbooks("CompanyBook.xlsm").Sheets("Aggregate")
End If
End If
Next

For Each ws In Workbooks("CompanyBook.xlsm").Worksheets
If FindString(ws.Name, "Report2") Then
ws.Name = "Report2"
ElseIf FindString(ws.Name, "Report1") Then
ws.Name = "Report1"
End If
Next ws

'Char mishap replacements
With Workbooks("CompanyBook.xlsm")
.Worksheets("Report1").Cells.Replace What:="&", Replacement:="&", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report1").Cells.Replace What:=""", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="’", Replacement:="’", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="…", Replacement:="…", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="£", Replacement:="£", LookAt:=xlPart, Ma

Solution

To supplement Gaffi's suggestions, I think you would benefit from changing this:

'Char mishap replacements
With Workbooks("CompanyBook.xlsm")
.Worksheets("Report1").Cells.Replace What:=""", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="’", Replacement:="’", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="…", Replacement:="…", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="£", Replacement:="£", LookAt:=xlPart, MatchCase:=False
'.Worksheets("Report2").Cells.Replace What:="‘", Replacement:="‘L", LookAt:=xlPart, MatchCase:=False
.Worksheets("Company").Select
End With


To this:

Dim r1 As Excel.Range, r2 As Excel.Range
Set r1 = Workbooks("CompanyBook.xlsm").Worksheets("Report1").Cells.SpecialCells(xlCellTypeConstants)
Set r2 = Workbooks("CompanyBook.xlsm").Worksheets("Report2").Cells.SpecialCells(xlCellTypeConstants)

With r1
    .Replace What:="&", Replacement:="&", LookAt:=xlPart, MatchCase:=False
    .Replace What:=""", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
End With

With r2
    .Replace What:="…", Replacement:="…", LookAt:=xlPart, MatchCase:=False
    .Replace What:="£", Replacement:="£", LookAt:=xlPart, MatchCase:=False
End With


This way, you narrow down the selection to only cells that have content for Excel to find/replace. Also, because you set the range to a variable once, Excel doesn't have to search through all cells multiple times like it is now.

Code Snippets

'Char mishap replacements
With Workbooks("CompanyBook.xlsm")
.Worksheets("Report1").Cells.Replace What:="&quot;", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="’", Replacement:="’", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="…", Replacement:="…", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="£", Replacement:="£", LookAt:=xlPart, MatchCase:=False
'.Worksheets("Report2").Cells.Replace What:="‘", Replacement:="‘L", LookAt:=xlPart, MatchCase:=False
.Worksheets("Company").Select
End With
Dim r1 As Excel.Range, r2 As Excel.Range
Set r1 = Workbooks("CompanyBook.xlsm").Worksheets("Report1").Cells.SpecialCells(xlCellTypeConstants)
Set r2 = Workbooks("CompanyBook.xlsm").Worksheets("Report2").Cells.SpecialCells(xlCellTypeConstants)

With r1
    .Replace What:="&amp;", Replacement:="&", LookAt:=xlPart, MatchCase:=False
    .Replace What:="&quot;", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
End With

With r2
    .Replace What:="…", Replacement:="…", LookAt:=xlPart, MatchCase:=False
    .Replace What:="£", Replacement:="£", LookAt:=xlPart, MatchCase:=False
End With

Context

StackExchange Code Review Q#24971, answer score: 4

Revisions (0)

No revisions yet.