looping macro to test for borders

[SteveDB1]

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 worksheet 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 worksheet 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.

 

[Gord Dibben]

ActiveSheet.UsedRange can be misleading.

When you hit CTRL + End where does Excel take you?

Might be far below what you think.

Try deleting all rows below and all columns right of the "actual" used
range.

Then save the file to reset the used range.


Gord Dibben MS Excel MVP

 

[Dave Peterson]

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
ActiveSheet.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]

Hi Gord,
When I hit ctrl+end it takes me to row 62.
I'd checked it before I even tried using the statement simply because I'd
done this before with other stuff.

 

[SteveDB1]

Thanks Dave.
I'll test this in the morning and let you know if I have any further troubles.

 

[SteveDB1]

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]

That's not quite what it does.

This is the portion that does the work.

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
ActiveSheet.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

You select a range and the code limits it to the first column in that range.

Then it loops through the the cells in that column.

It looks for a cell that has a topedge formatted the way you like. If it finds
it, it saves that cell in the TopCell variable.

Then it continues with the loop. It looks at the next cell (the one directly
below).

It continues to look down that column until it finds a cell that has that bottom
border that you like. If/when it finds one, it looks to see if it had a cell
with the top border.

If there is no cell above that cell that has that top edge (topcell is nothing),
then you get a msgbox.

But if there is a cell that has that top edge, then the range(topcell,botcell)
is merged.

Then it resets those variables to nothing -- so those two cells can't be used in
the next merge.

======

It only loops through the range once. It just keeps track of the state of the
border cells.

 

[SteveDB1]

So I don't JUST select a single cell I have to select the entire range that I
want operated on?

 

[Dave Peterson]

Just one column.

Your original code started with:
For Each rCell In Selection

So I figured you were starting with a multicell selection.

On the other hand, if you know what should be looked at, you could do it in
code.

Instead of
Set myRng = Selection

You might be able to use:

with activesheet 'or with worksheets("Somesheetnamehere")
set myrng = .range("c2", .cells(.rows.count,"C").end(xlup))
end with

This would look at all the cells in C2 through the last used cell in column C of
the activesheet.

(Used means a cell with something (a value or a formula) in it.)

So I don't JUST select a single cell I have to select the entire range that I
want operated on?

 

[SteveDB1]

Ok...... that es'plains every'ting......
DOH!!!
I get it now.

Thank you.

I wasn't expecting to select the entire range. The manual version that I
have I select a single group range (generally 4 to 8 cells in a single
column), and it merges that group, and I then have a looping element to allow
me to keep going.

Pretty slick. Again-- thank you (another satisfied customer ).