The problem I have is that the procedure is very large and it is quite repetitive so I was wondering how I could make it shorter and therefore run quicker.

below is 1/10th of the total procedure, basically, the next batch of loop statements (i.e. For Each c in rng) use Today1 and then Today2 and so on until Today9. There are 10 codes in each batch, so basically 100 'For Each c In rng' statements are used in the entire procedure.

Any help with this is appreciated. Please note, the data will not always reach row 10,000 as defined in the rng i.e. it might only reach row 6000 so i dont know if it is slow because the procedure is looking at empty rows?

Thanks

Sub test()

Application.ScreenUpdating = False

Dim today As Date, today1 As Date, today2 As Date, today3 As Date, today4 As Date, today5 As Date, today6 As Date, today7 As Date, today8 As Date, today9 As Date, today10 As Date

today = Sheets("Sheet2").Range("F9")

today1 = Sheets("Sheet2").Range("F10")

today2 = Sheets("Sheet2").Range("F11")

today3 = Sheets("Sheet2").Range("F12")

today4 = Sheets("Sheet2").Range("F13")

today5 = Sheets("Sheet2").Range("F14")

today6 = Sheets("Sheet2").Range("F15")

today7 = Sheets("Sheet2").Range("F16")

today8 = Sheets("Sheet2").Range("F17")

today9 = Sheets("Sheet2").Range("F18")

today10 = Sheets("Sheet2").Range("F19")

Dim rng As Range, c As Range

Dim countda, countdb, countdc, countdd, countde, countdf, countdg, countdh, countdi, countdj As Long

countda = 0

countdb = 0

countdc = 0

countdd = 0

countde = 0

countdf = 0

countdg = 0

countdh = 0

countdi = 0

countdj = 0

Sheets("Sheet3").Select

Set rng = Range("A1:G10000")

For Each c In rng

If c.Offset(0, 4) = "CODE1" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countda = countda + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE2" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdb = countdb + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE3" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdc = countdc + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE4" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdd = countdd + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE5" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countde = countde + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE6" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdf = countdf + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE7" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdg = countdg + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE8" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdh = countdh + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE9" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdi = countdi + 1

Next c

For Each c In rng

If c.Offset(0, 4) = "CODE10" And c.Offset(0, 5) = "" And c.Offset(0, 2) = today Then countdj = countdj + 1

Next c

Sheets("Sheet1").Select

[F11] = countda

[F12] = countdb

[F13] = countdc

[F14] = countdd

[F15] = countde

[F16] = countdf

[F17] = countdg

[F18] = countdh

[F19] = countdi

[F20] = countdj

End Sub