VBA code to delete row that meets certain condition

[nnick]

I am trying to use VBA to delete rows within a user selected range and user selected string with an inputbox.

But I have a problem, the code I have works but there are some instances where the user selected string is in row which contain data in column "I" that I need to keep but still clear the rest of the data in the row within columns A through H.

Does anyone know what I can add to the code to allow me to delete the entire row if column I is empty but if it's populated, delete everything in the row but the contents of column I.

Sub DeleteRowsWithinRange()




Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As String




xTitleIdRng = "Range"
xTitleIdDel = "Delete Text"




Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleIdRng, InputRng.Address, Type:=8)
DeleteStr = Application.InputBox("Delete Text", xTitleIdDel, Type:=2)
    For Each rng In InputRng
        If rng.Value = DeleteStr Then
            If DeleteRng Is Nothing Then
                Set DeleteRng = rng
            Else
                Set DeleteRng = Application.Union(DeleteRng, rng)
            End If
    End If
    Next
    DeleteRng.EntireRow.Delete
End Sub

[p45cal]

untested, try:

Sub DeleteRowsWithinRange()
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range, DeleteRng2 As Range
Dim DeleteStr As String

xTitleIdRng = "Range"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleIdRng, InputRng.Address, Type:=8)
DeleteStr = Application.InputBox("Delete Text", xTitleIdDel, Type:=2)
For Each rng In InputRng
  If rng.Value = DeleteStr Then
    If IsEmpty(rng.EntireRow.Cells(9).Value) Then
      If DeleteRng Is Nothing Then Set DeleteRng = rng Else Set DeleteRng = Application.Union(DeleteRng, rng)
    Else
      If DeleteRng2 Is Nothing Then Set DeleteRng2 = Union(Cells("A" & rng.Row & ":H" & rng.Row), Cells("J" & rng.Row & ":ZZ" & rng.Row)) Else Set DeleteRng2 = Application.Union(DeleteRng2, Union(Cells("A" & rng.Row & ":H" & rng.Row), Cells("J" & rng.Row & ":ZZ" & rng.Row)))
    End If
  End If
Next
If Not DeleteRng2 Is Nothing Then DeleteRng2.ClearContents
If Not DeleteRng Is Nothing Then DeleteRng.EntireRow.Delete
End Sub

[nnick]

untested, try:

Sub DeleteRowsWithinRange()
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range, DeleteRng2 As Range
Dim DeleteStr As String

xTitleIdRng = "Range"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleIdRng, InputRng.Address, Type:=8)
DeleteStr = Application.InputBox("Delete Text", xTitleIdDel, Type:=2)
For Each rng In InputRng
  If rng.Value = DeleteStr Then
    If IsEmpty(rng.EntireRow.Cells(9).Value) Then
      If DeleteRng Is Nothing Then Set DeleteRng = rng Else Set DeleteRng = Application.Union(DeleteRng, rng)
    Else
      If DeleteRng2 Is Nothing Then Set DeleteRng2 = Union(Cells("A" & rng.Row & ":H" & rng.Row), Cells("J" & rng.Row & ":ZZ" & rng.Row)) Else Set DeleteRng2 = Application.Union(DeleteRng2, Union(Cells("A" & rng.Row & ":H" & rng.Row), Cells("J" & rng.Row & ":ZZ" & rng.Row)))
    End If
  End If
Next
If Not DeleteRng2 Is Nothing Then DeleteRng2.ClearContents
If Not DeleteRng Is Nothing Then DeleteRng.EntireRow.Delete
End Sub

Thanks for the reply!! I'm just receiving a runtime error 5 and I'm not sure what's causing it yet

[p45cal]

Oops, change all 4 ocurrences of Cells in this line:
If DeleteRng2 Is Nothing Then Set DeleteRng2 = Union(Cells("A" & rng.Row & ":H" & rng.Row), Cells("J" & rng.Row & ":ZZ" & rng.Row)) Else Set DeleteRng2 = Application.Union(DeleteRng2, Union(Cells("A" & rng.Row & ":H" & rng.Row), Cells("J" & rng.Row & ":ZZ" & rng.Row)))
to Range, leaving:
If DeleteRng2 Is Nothing Then Set DeleteRng2 = Union(Range("A" & rng.Row & ":H" & rng.Row), Range("J" & rng.Row & ":ZZ" & rng.Row)) Else Set DeleteRng2 = Application.Union(DeleteRng2, Union(Range("A" & rng.Row & ":H" & rng.Row), Range("J" & rng.Row & ":ZZ" & rng.Row)))