Hi All, I think I am going around in circles trying to sort out a looping issue.

My scenario...
Think of this as having 43 separate rooms and in each room im randomly placing different objects.
The ten object names are #A to #J and could have none or many more than one object in each room.
In room 1, all objects found would prexix with 1 so 1#A, 1#B etc Room 2, 2#A, 2#B etc to room 43.

The objective is to list the contents of each room in another worksheet table.
1#A to 43#J is a big table to populate and believe VBA is the best way to tackle it as the database
could become huge.

The code runs but I am getting puzzled by the results when using different test values.
Any help with this would be gratefully appreciated.

Sub Site1()

Dim PS1 As String, PS2 As String, PS3 As String, PS4 As String, PS5 As String
Dim PS6 As String, PS7 As String, PS8 As String, PS9 As String, PS10 As String
Dim xx As Long

PS1 = "#A"
PS2 = "#B"
PS3 = "#C"
PS4 = "#D"
PS5 = "#E"
PS6 = "#F"
PS7 = "#G"
PS8 = "#H"
PS9 = "#I"
PS10 = "#J"

Dim rng As Range, cel As Range
Dim lastRow As Long, writeRow As Long, PS1c As Long, PS2c As Long
    
lastRow = Worksheets("Hire-Log").Cells(Rows.count, "C").End(xlUp).Row
writeRow = Worksheets("Matrix2").Cells(Rows.count, "A").End(xlUp).Row ' + 1

If lastRow <= 2 Then
Exit Sub
Else
Set rng = Worksheets("Hire-Log").Range("C3:C" & lastRow)
End If

xx = 1
For i = 1 To lastRow - 2

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = xx & PS1 Then PS1c = PS1c + 1
Next cel
If PS1c > 0 Then Worksheets("Matrix2").Range("A" & i + 1).Value = PS1c
PS1c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = xx & PS2 Then PS2c = PS2c + 1
Next cel
If PS2c > 0 Then Worksheets("Matrix2").Range("B" & i + 1).Value = PS2c
PS2c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = xx & PS3 Then PS3c = PS3c + 1
Next cel
If PS3c > 0 Then Worksheets("Matrix2").Range("C" & i + 1).Value = PS3c
PS3c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS4 Then PS4c = PS4c + 1
Next cel
If PS4c > 0 Then Worksheets("Matrix2").Range("D" & i + 1).Value = PS4c
PS4c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS5 Then PS5c = PS5c + 1
Next cel
If PS5c > 0 Then Worksheets("Matrix2").Range("E" & i + 1).Value = PS5c
PS5c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS6 Then PS6c = PS6c + 1
Next cel
If PS6c > 0 Then Worksheets("Matrix2").Range("F" & i + 1).Value = PS6c
PS6c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS7 Then PS7c = PS7c + 1
Next cel
If PS7c > 0 Then Worksheets("Matrix2").Range("G" & i + 1).Value = PS7c
PS7c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS8 Then PS8c = PS8c + 1
Next cel
If PS8c > 0 Then Worksheets("Matrix2").Range("H" & i + 1).Value = PS8c
PS8c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS9 Then PS9c = PS9c + 1
Next cel
If PS9c > 0 Then Worksheets("Matrix2").Range("I" & i + 1).Value = PS9c
PS9c = vbNull

For Each cel In rng
    If cel.Value = i And cel.Offset(0, 5).Value = PS10 Then PS10c = PS10c + 1
Next cel
If PS10c > 0 Then Worksheets("Matrix2").Range("J" & i + 1).Value = PS10c
PS10c = vbNull

xx = xx + 1

Next i

End Sub
Many thanks