S
Steve
good afternoon all.
With the help of someone last year, I received a macro that merges rows
based on a criteria. However, it's not working as I'd hoped, and I've slowly
been tinkering with it, and have now reached a point where I need some help
thinking the elements through to the next step.
My goal is to have it look for a border on the top of the starter cell, and
then iterate through each successive row until it finds the bottom border.
Once the two borders are located-- top and bottom, it selects all the rows,
and merges them.
This code below selects the first row, then drops one row, and merges the
two. It then selects a 3rd, and merges the previous, with the new selection.
In letting it run through to the end, instead of stopping at a row with a
bottom border, it ran all the way out to the end of the worksheet. Well, I
stopped it at 4500 or so. Yes, I had one really large merged cell......
Then, in seeking to limit it, the loop until counter acts as a binary
counter. This is not what I wanted.
I thought that I should place the if statement to test for borders. I then
wanted it to iterate through until no more borders were found, and then stop.
But my present use isn't working.
Please tell me what I'm missing.
Thank you in advance.
Here is the code:
--------------------------------------------------
Sub borderloop1()
Dim rCell, rCell1 As Range
Dim lX As Integer
Set rCell = Selection
Set rCell1 = Selection
Do
For Each rCell In Selection
If rCell.Borders(xlEdgeTop).LineStyle Or
rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Or xlDouble Then
rCell.Select
'MsgBox rCell.Address
'rCell.Offset(1, 0).Select
' ElseIf rCell.Borders(xlEdgeTop).LineStyle <> xlSolid Then
rCell.Offset(1, 0).Select
For Each rCell1 In Selection
If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Or
xlDouble Then
Application.DisplayAlerts = False
ActiveSheet.Range(rCell, rCell1).Select
With Selection
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
Application.DisplayAlerts = True
Set rCell = Nothing
Set rCell1 = Nothing
'MsgBox rCell.Address & rCell1.Address
End If
Next rCell1
End If
Next rCell
lX = lX + 1
'Selection.Offset(1, 0).Select
Loop Until lX = 2
'this acts as a binary counter. I.e., 2^1, 2^2, 2^3, 2^4, ..., 2^n
'where if I set lX to 1, it'll select 2 rows. If lX to 2, 4 rows,
'lX to 3, 8 rows, lX to 4, 16 rows
' and lX to 5, 32 rows. This is not acceptable.
End Sub
With the help of someone last year, I received a macro that merges rows
based on a criteria. However, it's not working as I'd hoped, and I've slowly
been tinkering with it, and have now reached a point where I need some help
thinking the elements through to the next step.
My goal is to have it look for a border on the top of the starter cell, and
then iterate through each successive row until it finds the bottom border.
Once the two borders are located-- top and bottom, it selects all the rows,
and merges them.
This code below selects the first row, then drops one row, and merges the
two. It then selects a 3rd, and merges the previous, with the new selection.
In letting it run through to the end, instead of stopping at a row with a
bottom border, it ran all the way out to the end of the worksheet. Well, I
stopped it at 4500 or so. Yes, I had one really large merged cell......
Then, in seeking to limit it, the loop until counter acts as a binary
counter. This is not what I wanted.
I thought that I should place the if statement to test for borders. I then
wanted it to iterate through until no more borders were found, and then stop.
But my present use isn't working.
Please tell me what I'm missing.
Thank you in advance.
Here is the code:
--------------------------------------------------
Sub borderloop1()
Dim rCell, rCell1 As Range
Dim lX As Integer
Set rCell = Selection
Set rCell1 = Selection
Do
For Each rCell In Selection
If rCell.Borders(xlEdgeTop).LineStyle Or
rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Or xlDouble Then
rCell.Select
'MsgBox rCell.Address
'rCell.Offset(1, 0).Select
' ElseIf rCell.Borders(xlEdgeTop).LineStyle <> xlSolid Then
rCell.Offset(1, 0).Select
For Each rCell1 In Selection
If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Or
xlDouble Then
Application.DisplayAlerts = False
ActiveSheet.Range(rCell, rCell1).Select
With Selection
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
Application.DisplayAlerts = True
Set rCell = Nothing
Set rCell1 = Nothing
'MsgBox rCell.Address & rCell1.Address
End If
Next rCell1
End If
Next rCell
lX = lX + 1
'Selection.Offset(1, 0).Select
Loop Until lX = 2
'this acts as a binary counter. I.e., 2^1, 2^2, 2^3, 2^4, ..., 2^n
'where if I set lX to 1, it'll select 2 rows. If lX to 2, 4 rows,
'lX to 3, 8 rows, lX to 4, 16 rows
' and lX to 5, 32 rows. This is not acceptable.
End Sub