Hi dsmuhammad,
Welcome to the forum!!
Try this (initially on a copy of your data as the results cannot be undone if they're not as expected) which as it doesn't loop is very fast:
Option Explicit
Sub Macro2()
'Written by Trebor76
'Visit my website www.excelguru.net.au
'Delete any rows from Col. A where there is no number in the cell.
'http://www.excelforum.com/excel-programming-vba-macros/958870-excel-vba-delete-rows-that-do-not-contain-a-number-in-the-string.html
Const lngStartRow As Long = 2 'Starting row for data. Change to suit.
Dim lngMyCol As Long, _
lngMyRow As Long
Dim xlnCalcMethod As XlCalculation
With Application
xlnCalcMethod = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
lngMyRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With Columns(lngMyCol)
With Range(Cells(lngStartRow, lngMyCol), Cells(lngMyRow, lngMyCol))
.Formula = "=IF(LEN(TRIM(LEFT(A" & lngStartRow & ",MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A" & lngStartRow & "&"" 0123456789""))-1)))=LEN(TRIM(A" & lngStartRow & ")),NA(),"""")"
ActiveSheet.Calculate
.Value = .Value
End With
On Error Resume Next 'Turn error reporting off - OK to ignore 'No cells found' message
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0 'Turn error reporting back on
.Delete
End With
With Application
.Calculation = xlnCalcMethod
.ScreenUpdating = True
End With
MsgBox "All rows without a number in Col. A have now been deleted.", vbInformation, "Excel Guru"
End Sub
I've also written an article about different ways to delete rows on my website which explains my code here.
Regards,
Robert
Bookmarks