Excel Macro for deleting rows IF cells not...
Solved/Closed
Related:
- Excel macro delete row if cell contains value
- Vba deleting rows that do not contain set values defined in range - Best answers
- Vba delete row if cell contains - Best answers
- If cell contains date then return value ✓ - Office Software Forum
- Excel conditional formatting if cell contains specific text - Excel Forum
- Count if cell contains number - Excel Forum
- Excel conditional formatting if another cell contains specific text ✓ - Excel Forum
- Spell number in excel without macro - Guide
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