Data Cleanse Macro Running Very Slow

Joined
Oct 17, 2012
Messages
1
Reaction score
0
Hi there,

I'm hoping someone might be able to help me.
I have written some code to cleanse some data using upper/proper functions and some conditional formatting.
I still have some more code to add but running the macro is already taking a very long time and occasionally causing the program to crash with a small amount of test data.
Can someone take a look at the below code and let me know where I might be going wrong and how I can correct it?
As a bit of background, the code below is repeated 4 times for 4 different tabs of data I have. Each tab can potentially reach 1000s of rows of data.

Sub cleansedata()
Sheets("Printer").Select
Rows("1:1").Select
Cells.Find(What:="Asset No", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Columns("A:A").EntireColumn.Select
For Each x In Selection
x.Value = UCase(x.Value)
Next
Rows("1:1").Select
Cells.Find(What:="Serial No", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Columns("A:A").EntireColumn.Select
For Each x In Selection
x.Value = UCase(x.Value)
Next
Rows("1:1").Select
Cells.Find(What:="Comment", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Columns("A:A").EntireColumn.Select
For Each x In Selection
x.Value = WorksheetFunction.Proper(x.Value)
Range("A1").Select
Next
Cells.FormatConditions.Delete
Range("B2:XFD1048576").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(A$1=""Large Paper Capable"",B$1=""Large Paper In Use"",A2=""N"",B2=""Y"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
 
Back
Top