Help with slow Macro

D

Dooza

Hi there,
I have created a Macro that is performing very slowly, its task is this:

Label Cell F2 as Duplicate
Insert Formula into F3 to check if there are duplicates of A3
Copy this formula to all other cells in F
Insert conditional format on F3 to change to red background when cell is
true
Sort sheet by F Desc, A Asc

Here is my macro, can anyone see anything obviously wrong with it? I
made it by recording my actions.

Sub FindDuplicates()
'
' FindDuplicates Macro
' Macro recorded 30/10/2008 by ACLHW103
'

'
Range("F2").Select
ActiveCell.FormulaR1C1 = "Duplicate"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("F3").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-5],RC[-5])>1"
Range("F3").Select
Selection.Copy
Range("F3:F4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F3").Select
Application.CutCopyMode = False
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=COUNTIF(A:A,A3)>1"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.Copy
Range("F3:F4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("F3"), Order1:=xlDescending,
Key2:=Range("A3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
Application.WindowState = xlMinimized
End Sub

Cheers,

Steve
 
D

Dooza

Dooza said:
Hi there,
I have created a Macro that is performing very slowly, its task is this:

Label Cell F2 as Duplicate
Insert Formula into F3 to check if there are duplicates of A3
Copy this formula to all other cells in F
Insert conditional format on F3 to change to red background when cell is
true
Sort sheet by F Desc, A Asc
Click to expand...

I have just realised that the formula is copied into rows that don't
have data, and goes to the maximum number of rows, which is why its
taking so long.

My worksheet has a title row, then a header row. The data is going to
change everytime this worksheet is used, so the number of rows will be
different. How do I make the macro select just the rows that have data
in them?

Cheers,

Steve
 
J

Joel

It is more probable that the screen updating or events are slowing down the
code

Looking at rows with data will probably slow the code down more not less. I
rewrote the code the way that I normally writte code. There were some
duplicate statement that were being executed because you didn't use
intermediate variables. Intermediate variable don't slow down the code. It
makes it easy to undersand and can remove duplicate code.

Sub FindDuplicates()
'
' FindDuplicates Macro
' Macro recorded 30/10/2008 by ACLHW103
'

Application.ScreenUpdating = False
Application.EnableEvents = False

'
with Range("F2")
.FormulaR1C1 = "Duplicate"
.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

with Range("F3")
.FormulaR1C1 = "=COUNTIF(C[-5],RC[-5])>1"
.Copy
set LastCells =Range("F3:F4").End(xlDown)
set PasteRange = Range(., LastCells)

PasteRange.PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= "=COUNTIF(A:A,A3)>1"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
PasteRange.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
end with

LastRow = Rows("2:2").Range(Selection, Selection.End(xlDown)).Row
Application.CutCopyMode = False
set SortRange = Rows("2:" & LastRow)
SortRange.Sort _
Key1:=Range("F3"), _
Order1:=xlDescending, _
Key2:=Range("A3"), _
Order2:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1,
MatchCase:= False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Application.WindowState = xlMinimized

Application.ScreenUpdating = False
Application.EnableEvents = False

End Sub
 
D

Dooza

Joel said:
It is more probable that the screen updating or events are slowing down the
code

Looking at rows with data will probably slow the code down more not less. I
rewrote the code the way that I normally writte code. There were some
duplicate statement that were being executed because you didn't use
intermediate variables. Intermediate variable don't slow down the code. It
makes it easy to undersand and can remove duplicate code.
Click to expand...

Hi Joel,
Thank you very much for looking at my problem for me. Whilst its not
worked, its a start.
Sub FindDuplicates()
'
' FindDuplicates Macro
' Macro recorded 30/10/2008 by ACLHW103
'

Application.ScreenUpdating = False
Application.EnableEvents = False

'
with Range("F2")
.FormulaR1C1 = "Duplicate"
.Characters(Start:=1, Length:=9).Font
Click to expand...

Invalid use of property is the error I get at this point.
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

with Range("F3")
.FormulaR1C1 = "=COUNTIF(C[-5],RC[-5])>1"
.Copy
set LastCells =Range("F3:F4").End(xlDown)
set PasteRange = Range(., LastCells)
Click to expand...

Syntax error is what I get here if I change the first bit back to the
way I had it before.
PasteRange.PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= "=COUNTIF(A:A,A3)>1"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
PasteRange.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
end with

LastRow = Rows("2:2").Range(Selection, Selection.End(xlDown)).Row
Application.CutCopyMode = False
set SortRange = Rows("2:" & LastRow)
SortRange.Sort _
Key1:=Range("F3"), _
Order1:=xlDescending, _
Key2:=Range("A3"), _
Order2:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1,
Click to expand...

There was an error here due to a missing _
MatchCase:= False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Application.WindowState = xlMinimized

Application.ScreenUpdating = False
Application.EnableEvents = False

End Sub
Click to expand...

This is my first attempt at macro's, I really don't have a clue, but I
am trying.

Thanks for the help so far!

Steve
 
J

Joel

I thought that would work.

from
Set PasteRange = Range(., LastCells)

to
Set PasteRange = Range(Range("F3"), LastCells)


Dooza said:
Joel said:
It is more probable that the screen updating or events are slowing down the
code

Looking at rows with data will probably slow the code down more not less. I
rewrote the code the way that I normally writte code. There were some
duplicate statement that were being executed because you didn't use
intermediate variables. Intermediate variable don't slow down the code. It
makes it easy to undersand and can remove duplicate code.
Click to expand...

Hi Joel,
Thank you very much for looking at my problem for me. Whilst its not
worked, its a start.
Sub FindDuplicates()
'
' FindDuplicates Macro
' Macro recorded 30/10/2008 by ACLHW103
'

Application.ScreenUpdating = False
Application.EnableEvents = False

'
with Range("F2")
.FormulaR1C1 = "Duplicate"
.Characters(Start:=1, Length:=9).Font
Click to expand...

Invalid use of property is the error I get at this point.
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

with Range("F3")
.FormulaR1C1 = "=COUNTIF(C[-5],RC[-5])>1"
.Copy
set LastCells =Range("F3:F4").End(xlDown)
set PasteRange = Range(., LastCells)
Click to expand...

Syntax error is what I get here if I change the first bit back to the
way I had it before.
PasteRange.PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:= "=COUNTIF(A:A,A3)>1"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
PasteRange.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
end with

LastRow = Rows("2:2").Range(Selection, Selection.End(xlDown)).Row
Application.CutCopyMode = False
set SortRange = Rows("2:" & LastRow)
SortRange.Sort _
Key1:=Range("F3"), _
Order1:=xlDescending, _
Key2:=Range("A3"), _
Order2:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1,
Click to expand...

There was an error here due to a missing _
MatchCase:= False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Application.WindowState = xlMinimized

Application.ScreenUpdating = False
Application.EnableEvents = False

End Sub
Click to expand...

This is my first attempt at macro's, I really don't have a clue, but I
am trying.

Thanks for the help so far!

Steve
Click to expand...
 
D

Dooza

Joel said:
I thought that would work.

from
Set PasteRange = Range(., LastCells)

to
Set PasteRange = Range(Range("F3"), LastCells)
Click to expand...

Thats got that part working, but its still filling 65536 rows, not just
the ones that have data. Any way to stop it?

Cheers,

Steve
 
J

Joel

You need to use xlup starting at 65536 not xldown. Rows.count = 65536

Sub FindDuplicates()
'
' FindDuplicates Macro
' Macro recorded 30/10/2008 by ACLHW103
'

Application.ScreenUpdating = False
Application.EnableEvents = False

'
With Range("F2")
.FormulaR1C1 = "Duplicate"
.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

With Range("F3")
.FormulaR1C1 = "=COUNTIF(C[-5],RC[-5])>1"
.Copy
Set LastCells = Range("F" & Rows.Count).End(xlUp)
Set PasteRange = Range(Range("F3"), LastCells)

PasteRange.PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=COUNTIF(A:A,A3)>1"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
PasteRange.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With

Application.CutCopyMode = False
Set SortRange = Rows("3:" & LastRow)
SortRange.Sort _
Key1:=Range("F3"), _
Order1:=xlDescending, _
Key2:=Range("A3"), _
Order2:=xlAscending, _
Header:=xlno, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Application.WindowState = xlMinimized

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 
D

Dooza

Hi Joel,
Thanks again for the help, I feel we are close, but am getting a type
mismatch error after this line:
Set SortRange = Rows("3:" & LastRow)
Click to expand...

Whats strange is that when going back to the worksheet, the first cell
has been created, but its not been copied. The part of the code where
its failing is the sorting part, so I would have expected the copy to
have happened already.

Steve
 
J

Joel

from
Set SortRange = Rows("3:" & LastRow)
to
Set SortRange = Rows("3:" & LastCells.Row)

I simplified the code and forgot I eliminate the LastRow variable.
 
D

Dooza

Joel said:
from
Set SortRange = Rows("3:" & LastRow)
to
Set SortRange = Rows("3:" & LastCells.Row)

I simplified the code and forgot I eliminate the LastRow variable.
Click to expand...

Thats sorted out the error, but its not doing anything. It just does the
first cell and thats it. Well, it also changes focus to the last used
window, like an email.

Steve
 
J

Joel

Tthe problem is with the statement below. I was using column F to determine
where the lastt row was located. If there is no data in column F that would
explain thhe problem. Change the F to a column that contains data in the
last row.

Set LastCells = Range("F" & Rows.Count).End(xlUp)
 
D

Dooza

Joel said:
Tthe problem is with the statement below. I was using column F to determine
where the lastt row was located. If there is no data in column F that would
explain thhe problem. Change the F to a column that contains data in the
last row.

Set LastCells = Range("F" & Rows.Count).End(xlUp)
Click to expand...

That makes sense, so I tried:

Set LastCells = Range("E" & Rows.Count).End(xlUp)

But this now copies the cells to E row and overwrites the information
there. We need to get the row count of E, but use it with F.

Steve
 
J

Joel

Try these changes. I modified th e PastRange and the Sort Range. I
replaced LastCells with LastRow


Sub FindDuplicates()
'
' FindDuplicates Macro
' Macro recorded 30/10/2008 by ACLHW103
'

Application.ScreenUpdating = False
Application.EnableEvents = False

'
With Range("F2")
.FormulaR1C1 = "Duplicate"
.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

With Range("F3")
.FormulaR1C1 = "=COUNTIF(C[-5],RC[-5])>1"
.Copy
LastRow = Range("E" & Rows.count).end(xlup).row
Set PasteRange = Range("F3:F" & LastRow)

PasteRange.PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=COUNTIF(A:A,A3)>1"
.FormatConditions(1).Interior.ColorIndex = 3
.Copy
PasteRange.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With

Application.CutCopyMode = False
Set SortRange = Rows("3:" & LastRow)
SortRange.Sort _
Key1:=Range("F3"), _
Order1:=xlDescending, _
Key2:=Range("A3"), _
Order2:=xlAscending, _
Header:=xlno, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Application.WindowState = xlMinimized

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 
D

Dooza

Joel said:
Try these changes. I modified th e PastRange and the Sort Range. I
replaced LastCells with LastRow
Click to expand...

Fantastic, now we're cooking on gas! Thats nice and quick too, for some
reason it still changes focus to another open program, but I can live
with that.

Thank you very much for your help!

Steve
 
D

Dooza

Joel said:
You are minimizing the window with this statement

Application.WindowState = xlMinimized
Click to expand...

That must have crept in when I was recording it, as its not intentional.
Thank you once again!

Steve
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help merging two VBA codes 2
= Today()+1 into Sheet1, Sheet2, and Sheet3 2
Help again!!! 1
Cleanup this macro please 3
Error using offset 2
Simplify Code for Copy/Paste Special 10
Copy paste - Values - formula - Optimise 2
wrong code 1

Top