View Single Post
 
Old 06-11-2015, 08:20 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,381
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote