0

Using this code it takes almost 30 seconds to complete work on 100 rows and 150 column my data is increasing swiftly and soon code will take more time to initiate. please guide me what is wrong with this code.

Sub Colourise()
Dim r As Long, Val As String, C As Long
Worksheets("Assets").Activate
r = 1
Val = ActiveSheet.Cells(r, 43).Value
C = 6 '6 is yellow, 8 is cyan
For r = 1 To ActiveSheet.Rows.Count
IsEmpty(ActiveSheet.Cells(r, 43).Value) Then ' column 43 is client name
Exit For
End If
If ActiveSheet.Cells(r, 43).Value <> Val Then
If C = 8 Then
C = 6
Else
C = 8
End If
End If
ActiveSheet.Range(Cells(r, 1), Cells(r, 80)).Select ' column 80 is end of data
With Selection.Interior
.ColorIndex = C
.Pattern = xlSolid
End With
Val = ActiveSheet.Cells(r, 43).Value
Next
End Sub

1 Answers1

1

The main problem here is that you are using ActiveSheet.Rows.Count, which is probably 2^20 rows (unless you have a very old version). The amount of data will not affect how long this takes to run, since you are looking at every row, empty or otherwise. It will always scan about 1M rows.

As well as referring to the specific sheet by name, you should use UsedRange instead.

i.e.

Dim ws as Worksheet
Set ws = Sheets("Your sheet")

For r = 1 To ws.UsedRange.Rows.Count
...
FlexYourData
  • 2,081
  • 1
  • 12
  • 14
  • Glad to. You might want to consider using conditional formatting instead of VBA for this task. – FlexYourData Jul 22 '20 at 10:57
  • can you please edit the code i have tried but its not working. –  Jul 22 '20 at 11:17
  • In what way is it "not working"? Is there an error somewhere? What does the entire new function look like (edit your post). – FlexYourData Jul 22 '20 at 11:19
  • Sub Colourise() Dim r As Long, Val As String, C As Long Dim ws As Worksheet Set ws = Sheets("Assets") r = 1 Val = ActiveSheet.Cells(r, 43).Value C = 6 '6 is yellow, 8 is cyan For r = 1 To ws.UsedRange.Rows.Count IsEmpty(ws.Cells(r, 43).Value) Then ' column 43 is client name Exit For End If If ws.Cells(r, 43).Value <> Val Then If C = 8 Then C = 6 Else C = 8 End If End If ws.Range(Cells(r, 1), Cells(r, 80)).Select ' column 80 is end of data With Selection.Interior .ColorIndex = C .Pattern = xlSolid End With Val = ws.Cells(r, 43).Value Next End Sub –  Jul 22 '20 at 11:21
  • You are missing an `If` before `IsEmpty` – FlexYourData Jul 22 '20 at 11:24