Excel Macro for deleting rows IF cells not...
Solved/Closed
Related:
- Vba delete row if cell contains
- Delete rows in excel vba based on criteria - Best answers
- Delete entire row if cell is blank vba - Best answers
- Count if cell contains number - Excel Forum
- Excel conditional formatting if another cell contains specific text ✓ - Excel Forum
- If cell contains text then return value multiple conditions ✓ - Excel Forum
- Vba case like - Guide
- Conditional formatting if cell contains text - Excel Forum
3 responses
I spent a lot of time trying to figure this out and finally got the correct Macro. All you have to do is highlight the information in the column and then run the following Macro. There will be a box that will prompt you what vaule you want to keep. This is good for up to 30,000 rows.
Sub DeleteRows()
Dim strToDelete As String
Dim rngSrc As Range
Dim NumRows As Integer
Dim ThisRow As Integer
Dim ThatRow As Integer
Dim ThisCol As Integer
Dim J As Integer
Dim DeletedRows As Integer
strToDelete = InputBox("Value to Trigger Keep, Jason????", "Delete Rows")
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
NumRows = rngSrc.Rows.Count
ThisRow = rngSrc.Row
ThatRow = ThisRow + NumRows - 1
ThisCol = rngSrc.Column
Dim topRows As Integer
Dim bottomRows As Integer
bottomRows = 30000
For J = ThisRow To NumRows Step 1
If Cells(J, ThisCol) = strToDelete Then
'Rows(J).Select
topRows = J
Exit For
DeletedRows = DeletedRows + 1
End If
Next J
For J = (topRows + 1) To NumRows Step 1
If Cells(J, ThisCol) <> strToDelete Then
'Rows(J).Select
bottomRows = J
Exit For
'DeletedRows = DeletedRows + 1
End If
Next J
If topRows <> 4 Then
ActiveSheet.Range(Cells(4, 1), Cells(topRows - 1, 52)).Select
Selection.delete Shift:=xlUp
End If
ActiveSheet.Range(Cells(bottomRows - topRows + 4, 1), Cells(30000, 52)).Select
Selection.delete Shift:=xlUp
'MsgBox "Number of deleted rows: " & DeletedRows
End Sub
Sub DeleteRows()
Dim strToDelete As String
Dim rngSrc As Range
Dim NumRows As Integer
Dim ThisRow As Integer
Dim ThatRow As Integer
Dim ThisCol As Integer
Dim J As Integer
Dim DeletedRows As Integer
strToDelete = InputBox("Value to Trigger Keep, Jason????", "Delete Rows")
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
NumRows = rngSrc.Rows.Count
ThisRow = rngSrc.Row
ThatRow = ThisRow + NumRows - 1
ThisCol = rngSrc.Column
Dim topRows As Integer
Dim bottomRows As Integer
bottomRows = 30000
For J = ThisRow To NumRows Step 1
If Cells(J, ThisCol) = strToDelete Then
'Rows(J).Select
topRows = J
Exit For
DeletedRows = DeletedRows + 1
End If
Next J
For J = (topRows + 1) To NumRows Step 1
If Cells(J, ThisCol) <> strToDelete Then
'Rows(J).Select
bottomRows = J
Exit For
'DeletedRows = DeletedRows + 1
End If
Next J
If topRows <> 4 Then
ActiveSheet.Range(Cells(4, 1), Cells(topRows - 1, 52)).Select
Selection.delete Shift:=xlUp
End If
ActiveSheet.Range(Cells(bottomRows - topRows + 4, 1), Cells(30000, 52)).Select
Selection.delete Shift:=xlUp
'MsgBox "Number of deleted rows: " & DeletedRows
End Sub
Jan 20, 2009 at 01:50 PM
Jan 11, 2010 at 02:43 PM
Let me know,
Peter