Merging worksheets and using find/replace

Question

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:="&amp;", Replacement:="&", LookAt:=xlPart, MatchCase:=False
.Worksheets("Report1").Cells.Replace What:="&quot;", Replacement:=Chr(34), LookAt:=xlPart, MatchCase:=False
.Worksheets("Report2").Cells.Replace What:="â€TM", 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
Application.ScreenUpdating = True
Exit Sub
Handler:
Application.ScreenUpdating = True
MsgBox "Please make sure that one and only one type of each database file is open.", vbExclamation, "Merge Documents"
End Sub
Function FindString(strCheck As String, strFind As String) As Boolean
Dim intPos As Integer
 intPos = InStr(strCheck, strFind)
 FindString = intPos > 0
End Function

Answer 1

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:="â€TM", 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.

• mango: just a question. let's say that the those initial character errors weren't there. would i suffer a performance loss if i ran the replace commands anyway?
• Joseph: @mango, yes, you would lose performance if those characters were not found. however, it would still run faster than if those characters were in there and the values were replaced after all. you can't really avoid it, to be honest. if you need to replace those characters than you need to check for them each time.

Answer 2

What lowest performance is always having to refresh the display information. And if you have to switch between sheets, time delays are added focus allocation.

Application.ScreenUpdating = False

Besides optimizing You've already suggested, maybe you should think about the possibility of rewriting your own Replace function. I see you're using the same parameters in all calls.

LookAt: = xlPart, 
MatchCase: = False 

The VB functions contain algorithms prepared for many different parameters. Are too complex for what you really need but it will always be less quick to use own functions and 100% designed for your target.

If execution speed is your priority, you should reinvent the wheel but look worse encoded.

Other general advice would directly access the value of the cells, without having to select them first.

Answer 3

Not for efficiency, but you can start with this... Convert this block:

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

to the following:

If FindString(wb.Name, "Report2") or FindString(wb.Name, "Report1") Then
 wb.Worksheets.Move after:=Workbooks("CompanyBook.xlsm").Sheets("Aggregate")
End If

Also, it looks like your FindString function is almost identical (just converting to Boolean) to the InStr you use within it, so why not just use InStr?

i.e.

If FindString(ws.Name, "Report2") Then

change to

If InStr(ws.Name, "Report2") > 0 Then

For your specific question, you can do your replace on a string variable and write that value back to the cell, rather than search on the cell each time. Accessing the actual cell is very slow. Change this:

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:="â€TM", 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 something like this:

With Workbooks("CompanyBook.xlsm")
 For Each varCell In .Worksheets("Report1").Cells ' THIS IS VERY BIG AND YOU SHOULD CONSIDER REFINING YOUR RANGE
 TempVal = varCell.Value2
 TempVal = Replace(TempVal, "&", "&")
 'and so on for all your replacements
 varCell.Value = TempVal
 Next varCell
End With

• mango: thanks for the help. I think you've shed some light on how I can make this an overall better method.