patternMinor
Merging worksheets and using find/replace
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
```
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
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:
To this:
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.
'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 WithTo 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 WithThis 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:=""", 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 WithDim 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 WithContext
StackExchange Code Review Q#24971, answer score: 4
Revisions (0)
No revisions yet.