Re: looping macro to test for borders

Good morning Dave.... and while that may sound like the HAL9000's morning
salutation, it's not meant to.....

I've run through your macro a few times to see if I can follow the logic,
and this is what I get out of it.
It looks at the myCell to see if there's a border at the top of the cell, if
so, it sets to the variable name- TopCell.
Once it finds that, it runs through to the end and stops.
If it does not find the topborder in myCel (say it's in the middle cells
where only the side edge borders exist)l, it comes to an end.
If it's at the bottom cell where a bottom border exists, it gives a message
and then stops.

My overall goal is to start at a top border cell, offset through a range of
cells, one cell at a time, until it finds a bottom border. Once it finds the
bottom border, I want it to select all of the cells from TopCell to BotCell
and merge them.
I then want to repeat the process through until there are no more borders--
I'd like it to stop at the last bottom border-- in that column.

At this location--
If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then
Set TopCell = myCell
---------
I tried inserting a myCell.offset(1,0) and it threw a compile error stating
that I was missing a set statement. I also tried a TopCell.offset.... Same
error.

Thank you.


"Dave Peterson" wrote:

I'm not quite sure I understand, but maybe this will get you closer:

Option Explicit
Sub borderloop2()
Dim myRng As Range
Dim myCell As Range

Dim TopCell As Range
Dim BotCell As Range

Set myRng = Selection

'just check the first column of the selected range??
For Each myCell In myRng.Columns(1).Cells
If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then
Set TopCell = myCell
Else
If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then
If TopCell Is Nothing Then
MsgBox "Missing topcell for: " & myCell.Address(0, 0)
Else
Set BotCell = myCell
Application.DisplayAlerts = False
Active***.Range(TopCell, BotCell).Merge
Application.DisplayAlerts = True
End If
'get ready for next pair
Set TopCell = Nothing
Set BotCell = Nothing
End If
End If
Next myCell
End Sub

SteveDB1 wrote:

Howdie all.
I have a macro that I obtained from a poster-- XP-- here last July and have
since modified.
The goal of the macro is to look through a work*** for borders on top of a
cell, then loop through until it finds a border on the bottom of a cell (I
then perform another call to macro to merge the cells into one).
I then loop through all of the used cells to the end where it finds no more
borders.
code below here.
-----------------------------------------------------------------------------
Sub borderloop1()
Dim rCell, rCell1 As range

Dim lX As Long
Do
For Each rCell In Selection
If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then
Selection.Offset(1, 0).Select
ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then
For Each rCell1 In Selection
If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then
MsgBox rCell.Address
End If
Next rCell1
End If
Next rCell
lX = lX + 1
Selection.Offset(1, 0).Select
Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False

End Sub
----------------------------------------------------------------
with my loop until lX = statement, I tried using UsedRange as my stopping
point and it kept going well past my actual used range (it would've kept
going all the way to the end of the work*** had I not stopped at at around
row 35,000-- my used range was 62 rows).
As I thought about it my goal for a stopping point is to stop at the last
bottom border.

How would I accomplish that?
I received a 91 run time error back stating that the object block or with
block variable not set, in using my present statement
(Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False).

Thank you.
Best.

--

Dave Peterson

.

Quantcast