Hi all,

this code is running insanely slow (measured in minutes rather than seconds). Bearing in mind that the number of 'cells' is going to be no more than 200, why should this be the case? I can't think of anyway to speed this up. Can't really share the full file as it is chock full of personal details, but any questions please ask.

For Each cell In Sheets("Personal").Range("A2:A" & rCnt) '''CYCLE THROUGH EVERY CCODE
        appCount = Application.WorksheetFunction.CountIf(apprange, cell) '''COUNT APPLICATIONS MADE BY EACH CCODE
        subCount = Application.WorksheetFunction.CountIf(subrange, cell) '''COUNT SUBJECTS STUDIED BY EACH CCODE
        gapCount = Application.WorksheetFunction.Max(appCount, subCount) '''ASCERTAIN HIGHEST NUMBER FOR THE PURPOSES OF LAYOUT LATER
        On Error Resume Next
        appRow = Application.WorksheetFunction.Match(cell, Sheet33.Range("A:A"), 0) '''WHICH ROW DOES THE APPLICATIONS LIST START FOR CCODE
        subrow = Application.WorksheetFunction.Match(cell, Sheet2.Range("A:A"), 0) '''WHICH ROW DOES SUBJECTS LIST START FOR CCODE
        
        name = cell.Offset(0, 4)
        
        newcell.Value = name
        i = 0
        For i = 0 To subCount - 1
            newcell.Offset(i, 1).Value = Sheet2.Range("B" & subrow + i)
            newcell.Offset(i, 2).Value = Sheet2.Range("D" & subrow + i)
            newcell.Offset(i, 3).Value = Sheet2.Range("E" & subrow + i)
            newcell.Offset(i, 4).Value = Sheet2.Range("F" & subrow + i)
            newcell.Offset(i, 5).Value = Sheet2.Range("G" & subrow + i)
        Next i
        
        j = 0
        For j = 0 To appCount - 1
            newcell.Offset(j, 6).Value = Sheet33.Range("B" & appRow + j)
            newcell.Offset(j, 7).Value = Sheet33.Range("C" & appRow + j)
            newcell.Offset(j, 8).Value = Sheet33.Range("D" & appRow + j)
        Next j
        
        Set newcell = ws.Range("A6500").End(xlUp).Offset(gapCount)
        newcount = newcount + gapCount
        Rows(newcount).Select
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ThemeColor = 1
                .TintAndShade = -0.249946592608417
                .Weight = xlMedium
            End With
        
    Next
This is the effect I am after:
tableexample.jpg