Building table

I'm tracking problems with lorries for a weekly report.

I got three diffrent "kind" of lorries:

Lorries with numbers less than 3500.

Lorries with numbers above 4000.

Lorries with numbers going from 3500 to 3599.

There are nine defined problems that I track so the table will show how many times a particular problem has occured.

For the lorries with numbers less than 3500 and numbers above 4000 I can group these in one row.

For the lorries with numbers between 3500 and 3599 I have to report each lorry with a problem on a separate row.

My problem is that building the report for takes a bit of time (for lorries between 3500 and 3599) and I wonder if anybody has a suggestion for speeding it up.

Code for lorries with number less than 3500:

For k = 0 To 8

For Each Cell In Range("C110:C" & Range("C" & _Rows.Count).End(xlUp).Row)

If Cell.Value < 3500 And Cell.Offset(0, 1).Value =
_Cells(3, 3 + k).Value Then
Cells(5, 3 + k).Value = Cells(5, 3 + k).Value + 1
End If
Next
Next

Code for lorries with numbers above 4000 same as previous code except: Cell.Value > 4000

Code for lorries number 3500 to 3599:

For r = 0 To 99
For k = 0 To 8

For Each Cell In Range("C110:C" & Range("C" & _Rows.Count).End(xlUp).Row)

If Cell.Value = Cells(6 + r, 2).Value And Cell.Offset(0, _1).Value = Cells(3, 3 + k).Value Then
Cells(6 + r, 3 + k).Value = Cells(6 + r, 3 + _k).Value+ 1
End If
Next
Next
Next

Gratefull for any help on this problem.

Originally Posted by Alf

My problem is that building the report for takes a bit of time (for lorries between 3500 and 3599) and I wonder if anybody has a suggestion for speeding it up.

Try turning off screen updating at the start of the code

application.screenupdating=false

Thanks I did have it turned off in my macro. I also have no calculations going on so I can't gain by setting calc to manual.

It's hard to provide advice as you haven't provided all your code. Some thoughts.

1. Make sure you dimension all your variables
2. consider changing your loops. ie could you next the k=0 to 8 inside the for each cell code? It is hard to tell from the info provided. Or better still, is there a way to test using the if statements once, then applying all the changes at once?

Sorry, my bad. Here comes all the code:

Sub UpDate_car()

Dim i As Integer
Dim r As Integer
Dim k As Integer
Dim Cell As Range

Application.ScreenUpdating = False

Rows("6:105").EntireRow.Hidden = False

Range("C5:K105").ClearContents

Range("C120").Value = "Indata"


For i = 1 To 7

Sheets(i).Activate

Range("D3:D28,K3:K28").Copy

Sheets("Summary per Fleet no").Activat

Cells(Rows.Count, "C").End(xlUp).Offset(1, _ 0).PasteSpecial Paste:=xlPasteValues

Next i

Application.CutCopyMode = False

For k = 0 To 8

For Each Cell In Range("C120:C" & Range("C" & Rows.Count).End(xlUp).Row)

If Cell.Value < 3500 And Cell.Offset(0, 1).Value = Cells(3, 3 + k).Value Then
Cells(5, 3 + k).Value = Cells(5, 3 + k).Value + 1
End If
Next
Next

For k = 0 To 8

For Each Cell In Range("C120:C" & Range("C" & Rows.Count).End(xlUp).Row)

If Cell.Value > 4000 And Cell.Offset(0, 1).Value = Cells(3, 3 + k).Value Then
Cells(5, 3 + k).Value = Cells(5, 3 + k).Value + 1
End If
Next
Next

For r = 0 To 99
For k = 0 To 8

For Each Cell In Range("C120:C" & Range("C" & Rows.Count).End(xlUp).Row)

If Cell.Value = Cells(6 + r, 2).Value And Cell.Offset(0, 1).Value = _
Cells(3, 3 + k).Value Then
Cells(6 + r, 3 + k).Value = Cells(6 + r, 3 + k).Value + 1
End If
Next
Next
Next

Range("C120:D" & Range("C" & Rows.Count).End _(xlUp).Row).ClearContents

' Filter lorries with no problems

For i = 0 To 99

For Each Cell In Range("L6:L105")

If Cells(6 + i, 12).Value = 0 Then
Cells(6 + i, 12).EntireRow.Hidden = True
End If
Next
Next

Application.ScreenUpdating = True

Range("F2").Select

End Sub