Optimising Code

[Ladymuck]

I have the following that is part of a larger piece of code that formats a
worksheet. Currently, this part takes 15 minutes to run and I would like to
know if I could have written this code in a better way:

For Each c In r
If c.Value = "Complete" Or c.Value = "Not Applicable" Then
With Cells(c.Row, c.Column - 28)
.ClearFormats
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.Font.Name = "Verdana"
.Font.Size = 8
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.NumberFormat = "dd/mm/yy"
End With
End If
Next

This is running on a area that is 203 rows x 17 columns, the number of rows
varies.

I cannot use conditional formatting as it already exists in the target cells
and has to be removed and reformatted as above. Unless there is a better way,
of course!

Many thanks for any suggestions
Louise

 

[paul.robinson]

Hi
Do the formatting in one go:
Set myRange = Nothing
For Each c In r
If c.Value = "Complete" Or c.Value = "Not Applicable" Then
Set myRange = Union(myRange, Cells(c.Row, c.Column - 28) )
end if
Next c
With myRange
.ClearFormats
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.Font.Name = "Verdana"
.Font.Size = 8
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.NumberFormat = "dd/mm/yy"
End With

regards
Paul

 

[JE McGimpsey]

My guess is that you didn't test this since

Set myRange = Union(myRange, Cells(c.Row, c.Column - 28) )

will cause a run-time error the first time it's executed.


Sightly modified:

Set myRange = Nothing
r.Offset(0, -28).ClearFormats
For Each c In r
With c
If .Value = "Complete" Or .Value = "Not Applicable" Then
If myRange Is Nothing Then
Set myRange = c.Offset(0, -28)
Else
Set myRange = Union(myRange, c.Offset(0, -28))
End If
End If
End With
Next c
If Not myRange Is Nothing Then
With myRange
.Interior.ColorIndex = 5
With .Font
.ColorIndex = 2
.Name = "Verdana"
.Size = 8
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.NumberFormat = "dd/mm/yy"
End With
End If

 

[Peter T]

Just to add, first need to assign myRange to a range before attempting the
Union.

From the OP's description Uinion could end up making a lot of non-contiguous
areas, best to limit to say 100, process and start afresh, eg

Sub test()
Dim r As Range, c As Range
Dim myRange As Range
Set myRange = Nothing
Set r = Range("AD1:AM20")

For Each c In r
If c.Value = "Complete" Or c.Value = "Not Applicable" Then
If myRange Is Nothing Then
Set myRange = Cells(c.Row, c.Column - 28)
Else

Set myRange = Union(myRange, Cells(c.Row, c.Column - 28))
End If
If myRange.Areas.Count > 50 Then
doFormat myRange
Set myRange = Nothing
End If
End If
Next c
If Not myRange Is Nothing Then
doFormat myRange
End If

End Sub

Sub doFormat(rng As Range)
With rng
.Select
.ClearFormats ' ??
With Font
.Font.Name = "Verdana"
.Font.Size = 8
.Font.ColorIndex = 2
End With
.Interior.ColorIndex = 5
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.NumberFormat = "dd/mm/yy"
End With
End Sub

Regards,
Peter T

Hi
Do the formatting in one go:
Set myRange = Nothing
For Each c In r
If c.Value = "Complete" Or c.Value = "Not Applicable" Then
Set myRange = Union(myRange, Cells(c.Row, c.Column - 28) )
end if
Next c
With myRange
.ClearFormats
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.Font.Name = "Verdana"
.Font.Size = 8
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.NumberFormat = "dd/mm/yy"
End With

regards
Paul

 

[JE McGimpsey]

I think Peter T meant:

Sub doFormat(rng As Range)
With rng
.Select
.ClearFormats ' ??
With .Font
.Name = "Verdana"
.Size = 8
.ColorIndex = 2
End With
.Interior.ColorIndex = 5
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.NumberFormat = "dd/mm/yy"
End With
End Sub

though I don't know why one would select the range...

 

[Ladymuck]

Thanks for the suggestions, I'll give them a try.

 

[Peter T]

Thanks for that!

though I don't know why one would select the range...

er, remove .Select

I put .Select in to test something and forgot to remove it. The With Font
part was last moment and didn't test that - bad !

Regards,
Peter T

 

[JE McGimpsey]

I put .Select in to test something and forgot to remove it. The With Font
part was last moment and didn't test that - bad !

Gee... *I've* never done that! <g>

 

[paul.robinson]

Quite right - didn't test it!
The union method can be slow too - it might be quicker to hide rows in
r not meeting the criteria (possibly using filter) then use

Set myRange = r.SpecialCells(xlCellTypeVisible)
With myRange
'do formatting
End With

then unfilter the rows in r.
regards
Paul

 

[Peter T]

Gee... *I've* never done that! <g>