With 54000 rows of data, the following took 1.25 minutes on my laptop:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim lRow As Long, lCol As Long, i As Long, j As Long, x As Long
Dim eTime As Single
' Start Timing
eTime = Timer
With ThisWorkbook.Worksheets("Sheet1").UsedRange
.Columns(3).Insert
.Cells(1, 3).Value = "Active/Inactive"
lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
On Error Resume Next
For i = lRow To 1 Step -1
If .Range(.Cells(i, 1), .Cells(i, lCol)).SpecialCells(xlCellTypeBlanks).Count < lCol Then lRow = i: Exit For
Next
For i = lCol To 1 Step -1
If .Range(.Cells(1, i), .Cells(lRow, i)).SpecialCells(xlCellTypeBlanks).Count < lRow Then lCol = i: Exit For
Next
On Error GoTo 0
For i = 2 To lRow
x = 0
For j = 5 To lCol
If UCase(.Cells(i, j).Text) = "TRUE" Then x = x + 1
Next
.Cells(i, 3).Value = x
.Cells(i, 14).Value = x & .Cells(i, 2).Value
Next
End With
Application.ScreenUpdating = True
' Calculate elapsed time
eTime = (Timer - eTime + 86400) Mod 86400 ' Just in case execution time spans midnight
MsgBox "Execution took " & Format(eTime / 86400, "hh:mm:ss")
End Sub