Excel Macro for deleting rows IF cells not...
Solved/Closed
Related:
- Vba deleting rows that do not contain set values defined in range
- Vba delete row if cell contains - Best answers
- Delete entire row if cell is blank vba - Best answers
- Based on the values in cells b77 ✓ - Excel Forum
- Vba case like - Guide
- How to set redial in android - Guide
- Fill adjacent cell with number from text answer ✓ - Excel Forum
- Winrar set password not working - 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