Crocdundee
Board Regular
- Joined
- May 10, 2010
- Messages
- 174
- Office Version
- 2013
- Platform
- Windows
Hi Excel Gurus, I have found an example piece of code which could be of use to me.
However it does not work, and I was hoping you could fix it for me.
I am using 2007
The sheet is named Sheet1
The array data comes from A2:A
I wish to delete rows containing the names in the Array
Regards
Graham
Sub Example1()
Dim varList As Variant
Dim lngarrCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
varList = VBA.Array("Warwick", "Great Yarmouth", "Southwell", "Clairwood", "Turffontein Standside", "Sedgefield", "Beverley", "Sha Tin")
For lngarrCounter = LBound(varList) To UBound(varList)
With Sheet1.UsedRange
Set rngFound = .Find( _
What:=varList(lngarrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngarrCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
However it does not work, and I was hoping you could fix it for me.
I am using 2007
The sheet is named Sheet1
The array data comes from A2:A
I wish to delete rows containing the names in the Array
Regards
Graham
Sub Example1()
Dim varList As Variant
Dim lngarrCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
varList = VBA.Array("Warwick", "Great Yarmouth", "Southwell", "Clairwood", "Turffontein Standside", "Sedgefield", "Beverley", "Sha Tin")
For lngarrCounter = LBound(varList) To UBound(varList)
With Sheet1.UsedRange
Set rngFound = .Find( _
What:=varList(lngarrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngarrCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub