![]() |
#13
|
||||
|
||||
![]()
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] |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
ndnd | Word VBA | 10 | 01-06-2015 01:47 PM |
Help with IF or ELSE Formulas | tsaladyga | Excel | 4 | 07-23-2014 09:04 AM |
Search and replace/insert HTML code into Master File using tags | dave8555 | Excel | 2 | 02-23-2014 03:51 PM |
Need help with formulas please | paul_pearson | Excel | 0 | 03-20-2013 06:51 AM |
![]() |
mizzamzz | Excel | 1 | 07-08-2010 02:32 AM |