Prev: Check Box macro
Next: System Error &H8007007E (-2147024770) The specified module cou
From: Bill Renaud on 16 Nov 2007 16:07
OK, try the following revised version. Realize that this macro only checks
for data rows starting at row 6 (cell $A$6). I am a little curious as to
why you would have 5 blank rows above the data on the worksheet. Maybe they
simply have data that you want to be sure and ignore. If so, then I can
understand.

'----------------------------------------------------------------------
Public Sub RemoveBlock1Rows()
'Change Target Values here.
Const TargetValue1 = "Value1"
Const TargetValue2 = "Value2"

Dim wsActive As Worksheet
Dim blnNoMoreTargetRows As Boolean
Dim rngBlock1 As Range
Dim lngBlock1ColsWide As Long
Dim lngBlock1LastRow As Long
Dim rngBlock1ColB As Range
Dim varSearchValue As Variant
Dim blnFindValue2 As Boolean
Dim rngTarget As Range
Dim rngTargetRow As Range

On Error Resume Next

Application.ScreenUpdating = False

Set wsActive = ActiveSheet
blnNoMoreTargetRows = False
blnFindValue2 = False
varSearchValue = TargetValue1

Do
'Need to check this every loop, as the top row
'may have been deleted on a previous iteration.
'Block1 always begins with cell "A6".
With wsActive
lngBlock1ColsWide = .Range("A6").CurrentRegion.Columns.Count
lngBlock1LastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
End With

With wsActive
Set rngBlock1 = .Range("A6") _
.Resize(lngBlock1LastRow - 5, lngBlock1ColsWide)
End With

With rngBlock1
Set rngBlock1ColB = .Resize(.Rows.Count, 1).Offset(0, 1)
End With

'Find and delete all "TargetValue1" rows first,
'then find and delete all "TargetValue2" rows.
Set rngTarget = rngBlock1ColB.Find(What:=varSearchValue, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If rngTarget Is Nothing _
Then
If blnFindValue2 _
Then
blnNoMoreTargetRows = True
Else
blnFindValue2 = True
varSearchValue = TargetValue2
End If
Else
'Delete entire row in Block1.
Set rngTargetRow = wsActive.Cells(rngTarget.Row, 1) _
.Resize(1, lngBlock1ColsWide)
rngTargetRow.Delete Shift:=xlUp
End If
Loop Until blnNoMoreTargetRows
End Sub

--
Regards,
Bill Renaud



First  |  Prev  | 
Pages: 1 2
Prev: Check Box macro
Next: System Error &H8007007E (-2147024770) The specified module cou