The slow part of your code is the loop dumping the formulas cell by cell
A much faster technique would be to write your formulas in a single range
Can you pls post an actual sample
Cheers
Dave
Dim MissingPhCt As Integer
Dim R as Integer
Columns("T:V").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("T2").Select
For MissingPhCt = 1 To LastRow - 1
R = MissingPhCt + 1
ActiveCell.Offset(MissingPhCt - 1, 0) = WorksheetFunction.CountIf(Range(Cells(R, "Q"), Cells(R, "S")), "")
Next MissingPhCt
Range("T1").Value = "Missing Phone #s"
Range(Cells(1, 1), Cells(LastRow, LastCol + 3)).Select
Selection.Copy
ActiveCell.Offset(1,0).Formula = "=COUNTIF(Q1,S1)"
ActiveCell.Offset(1,0).Resize(LastRow,)
'Or with copy/paste
ActiveCell.Offset(1,0).Formula = "=COUNTIF(Q1,S1)"
ActiveCell.Offset(1,0).Copy Destination:=Range(ActiveCell.Offset(1,0).Address,ActiveCell.Offset(LastRow,0).Address)
ActiveCell.Offset(1,0).Formula = "=COUNTIF(Q1,S1)"
ActiveCell.Offset(1,0).Copy
Range(ActiveCell.Offset(1,0).Address,ActiveCell.Offset(LastRow,0).Address).PasteSpecial xlPasteValues
Dim MissingPhCt As Integer
Dim R As Integer
Dim mArray As Variant
'LastRow = 142 --> This was not mentioned, just declared it for testing
Application.ScreenUpdating = False
Columns("T:V").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
mArray = Range("T2:T" & LastRow).Value
For MissingPhCt = 1 To LastRow - 1
R = MissingPhCt + 1
mArray(MissingPhCt, 1) = WorksheetFunction.CountIf(Range(Cells(R, "Q"), Cells(R, "S")), "")
Next MissingPhCt
Range("T2:T" & LastRow) = mArray
Range("T1").Value = "Missing Phone #s"
Range(Cells(1, 1), Cells(LastRow, LastCol + 3)).Select
Selection.Copy
Application.ScreenUpdating = True
Range("T2").Select
ActiveCell.Offset(0, 0).Formula = "=COUNTIF(Q2:S2,"""")"
ActiveCell.Offset(0, 0).Copy
Range(ActiveCell.Offset(0, 0).Address, ActiveCell.Offset(LastRow - 2, 0).Address).PasteSpecial xlPasteFormulas
Range(ActiveCell.Offset(0, 0).Address, ActiveCell.Offset(LastRow - 2, 0).Address).Copy
Range(ActiveCell.Offset(0, 0).Address, ActiveCell.Offset(LastRow - 2, 0).Address).PasteSpecial xlPasteValues
Sub test()
Dim rng As Range
Dim LastRow As Long
LastRow = 40000
Set rng = Range("T2:T" & LastRow - 2)
rng.Formula = "=COUNTIF(" & Cells(rng.Row, rng.Column - 3).Address(False, False) & ":" & Cells(rng.Row, rng.Column - 1).Address(False, False) & ","""")"
rng.Copy
rng.PasteSpecial xlPasteValues
End Sub
Title | # Comments | Views | Activity |
---|---|---|---|
Excel and Formulas | 8 | 30 | |
Excel 2013 how to Get the earliest time per day user wise | 6 | 22 | |
How do I enter a formula in Excel to capture a part of text from a cell? | 7 | 25 | |
Index/Match with Multiple Criteria | 2 | 11 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
7 Experts available now in Live!