Prev: Check Box macro
Next: System Error &H8007007E (-2147024770) The specified module cou
From: djd011 on 8 Nov 2007 15:22
Hi everybody,
I am working on a macro to help automate some of the tasks being done to a
group of spreadsheets that are updated often. I can email a dummy workbook to
illustrate what I am talking about if necessary, just let me know.
My workbook contains 2 ranges of data, the first contains a table of values
and within this table are the target rows. This first range varies in size
both in number of Rows and Columns which is where I am having one of two hang
ups.
The second Range is located to the right of the first range and is always 3
columns wide. Its number of rows is variable and can be as long as the first
range but not longer. The two ranges are separated by 2 blank columns,(for
example Range 1:(A6:J45) Range 2:(M6:O32)), and both start on row 6.

What I would like the macro to do is this. Search through the "B" column of
the first range to find a target row by finding the cells with "TargetValue1"
and "TargetValue2". Once a target row is detected I would like to delete the
Row ut only within the first range, and Shift the Cells Up.


Thank you all for any guidance,
>>Dan


From: Otto Moehrbach on 9 Nov 2007 21:42
Specifically, what are you having a problem with? Post back and go through
the process you are using, step-by-step, and detail the problem. HTH Otto
"djd011" <djd011(a)discussions.microsoft.com> wrote in message
news:34A40A63-AD5E-4FC6-B8D7-D4FEFE9AF63A(a)microsoft.com...
> Hi everybody,
> I am working on a macro to help automate some of the tasks being done to a
> group of spreadsheets that are updated often. I can email a dummy workbook
> to
> illustrate what I am talking about if necessary, just let me know.
> My workbook contains 2 ranges of data, the first contains a table of
> values
> and within this table are the target rows. This first range varies in size
> both in number of Rows and Columns which is where I am having one of two
> hang
> ups.
> The second Range is located to the right of the first range and is always
> 3
> columns wide. Its number of rows is variable and can be as long as the
> first
> range but not longer. The two ranges are separated by 2 blank
> columns,(for
> example Range 1:(A6:J45) Range 2:(M6:O32)), and both start on row 6.
>
> What I would like the macro to do is this. Search through the "B" column
> of
> the first range to find a target row by finding the cells with
> "TargetValue1"
> and "TargetValue2". Once a target row is detected I would like to delete
> the
> Row ut only within the first range, and Shift the Cells Up.
>
>
> Thank you all for any guidance,
>>>Dan
>
>


From: Bill Renaud on 10 Nov 2007 00:56
Try the following routine.

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

Dim wsActive As Worksheet
Dim blnNoMoreTargetRows As Boolean
Dim rngBlock1CurrentRegion As Range
Dim lngRowsAboveBlock1 As Long
Dim rngBlock1 As Range
Dim lngBlock1ColsWide 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".
Set rngBlock1CurrentRegion = wsActive.Range("A6").CurrentRegion

With rngBlock1CurrentRegion
lngRowsAboveBlock1 = 6 - .Row
Set rngBlock1 = .Resize(.Rows.Count - lngRowsAboveBlock1) _
.Offset(lngRowsAboveBlock1)
End With

With rngBlock1
lngBlock1ColsWide = .Columns.Count
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



From: djd011 on 15 Nov 2007 12:11
Bill,

Thank you very much for the help, and I am very sorry for taking so long to
review it. I have tested what you sent and it works perfectly in all but one
situation.

On one of the sheets I need to use the macro on, the column that is being
checked by the macro has some blank cells in it. Is there a way that I can
change the macro, so it will see a blank row and attempt to skip it. The
range one looks somewhat like this:
A B
2
3
4
5
6 Label Data
7 Data
8 Data
9 TargVal1
10 TargVal2
11 Data
12
13 Label Data
14 Data
15 TargVal1
16 Data
17 TargVal2
18 Data
.... ...



Hopefully that illustrates a little better what I am trying to do. I just
need to modify the macro so that if it sees a blank row it will skip it.

Thank you again, I really appreciate the help!
>>Dan




"Bill Renaud" wrote:

> Try the following routine.
>
> '----------------------------------------------------------------------
> Public Sub RemoveBlock1Rows()
> 'Change Target Values here.
> Const TargetValue1 = "Value1"
> Const TargetValue2 = "Value2"
>
> Dim wsActive As Worksheet
> Dim blnNoMoreTargetRows As Boolean
> Dim rngBlock1CurrentRegion As Range
> Dim lngRowsAboveBlock1 As Long
> Dim rngBlock1 As Range
> Dim lngBlock1ColsWide 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".
> Set rngBlock1CurrentRegion = wsActive.Range("A6").CurrentRegion
>
> With rngBlock1CurrentRegion
> lngRowsAboveBlock1 = 6 - .Row
> Set rngBlock1 = .Resize(.Rows.Count - lngRowsAboveBlock1) _
> .Offset(lngRowsAboveBlock1)
> End With
>
> With rngBlock1
> lngBlock1ColsWide = .Columns.Count
> 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
>
>
>
>
From: Bill Renaud on 16 Nov 2007 13:56
Hi dyd011!

Good thing I just happened to see this reply, as I had turned the "watch"
off on this thread and had deleted the rest of it a few days ago! This is
why it is a good idea to always reply within a day or so after you get
replies (answers or tips) to your original post!

Does this worksheet also have the "second Range" that is located to the
right of the first range and is always 3 columns wide, as mentioned in your
original post?

The current macro gets the "CurrentRegion" of cell $A$6, so that is why it
stops working at the first blank line of data. This can be fixed. I just
want to make sure that the macro can correctly identify all of the first
range, without including the second range.
--
Regards,
Bill Renaud



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