Hi John,
Try:
'================>>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim delRng As Range
Dim CalcMode As Long
Dim searchStr As String
Const SearchCol As String = "G" '<<===== CHANGE
Set WB =Workbooks("YourBook.xls") '<<===== CHANGE
Set SH = WB.Sheets("Sheet4") '<<===== CHANGE
searchStr = SH.Range("A1").Value '<<===== CHANGE
With SH
Set rng = Intersect(.Range("Names"), .Columns(SearchCol))
End With
If rng Is Nothing Then Exit Sub
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For Each rCell In rng.Cells
rCell.Select
If UCase(rCell.Value) = UCase(searchStr) Then
If delRng Is Nothing Then
Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
End If
Next rCell
If Not delRng Is Nothing Then
'\\ ***SEE BELOW << ======
'Delete entire row
delRng.EntireRow.Delete
'Or, delete the contents of the entire row
' delRng.EntireRow.ClearContents
'Or, delete the intersection of the row with the "Names" range
' Intersect(delRng.EntireRow, SH.Range("Names")). _
Delete Shift:=xlUp
'Or, delete contents of the intersection of the row and "Names" range
' Intersect(delRng.EntireRow, SH.Range("Names")).ClearContents
End If
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'<<================
***
According to whether you wish to delete entire rows, delete part rows,
delete the contents of entire rows, or delete the contents of part rows,
choose the indicated code option and delete the remaining three. Note that
you will additionally need to delete the initial apostrophe for the selected
code line (not the preceding comment!).
If there are still problems, perhaps you could additionally indicate which
of these options corresponds with your requirements.