merge cells

[Steve]

Morning all.

Let's see.... I've modified an existing macro to test for borders, and to
merge the selected cells.

My If test appears to work ok, but my core operation doesn't.

My code is:

For Each rcell2 In Selection

If rcell2.Borders(xlEdgeBottom).LineStyle = xlSolid Then

ActiveSheet.Range(rcell1, rcell2).Select

With Selection

.Merge

.VerticalAlignment = xlCenter

.HorizontalAlignment = xlCenter

End With

'Set rcell1 = Nothing

'Set rcell2 = Nothing

ActiveCell.Offset(1, 0).Select

'end if

End If

Next rcell2

I have 3 if tests outside of the above. My intention was to iterate through
a series of rows, looking for a border on top, and a border on the bottom,
after an undefined number of rows.



Once it finds the rows, I want to select them, and merge them.

However, in the case of my present macro, it merges, iterates through a
second set of rows, and selects the first set, and then selects, and merges
the second set with the first set.

This does not work.

My thinking at this point is that the rcell1 variable has the first row's
location still stored in its buffer, and if this indeed the case, I need the
rcell1 buffer emptied, to start with a new row location.

The problem is-- I'm not clear on how this is done. Anyone know how to do
this?

Thank you.

 

[Dave Peterson]

I'd loop through the rows (not the selection).

Dim iRow as long
dim FirstRow as long
dim LastRow as long

dim TopCell as range
dim BotCell as range

with activesheet
firstrow = 1
lastrow = .cells(.rows.count,"A").end(xlup).row 'or whatever you want

for irow = firstrow to lastrow
if .cells(irow,"A")..Borders(xlEdgeTop).LineStyle = xlSolid then
set topcell = .cells(irow,"A")
set botcell = nothing 'start looking
else
if .cells(irow,"A").borders(xledgebottom).linestyle = xlsolid then
if topcell is nothing then
'keep looking, because we're not in a "group"
else
set botcell = .cells(irow,"A")
with .range(topcell,botcell)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
'get ready to start looking again
set topcell = nothing
set botcell = nothing
end if
end if
end if
next irow
end with

untested, uncompiled. Watch out for typos.

I used column A to look for those borders.

Morning all.

Let's see.... I've modified an existing macro to test for borders, and to
merge the selected cells.

My If test appears to work ok, but my core operation doesn't.

My code is:

For Each rcell2 In Selection

If rcell2.Borders(xlEdgeBottom).LineStyle = xlSolid Then

ActiveSheet.Range(rcell1, rcell2).Select

With Selection

.Merge

.VerticalAlignment = xlCenter

.HorizontalAlignment = xlCenter

End With

'Set rcell1 = Nothing

'Set rcell2 = Nothing

ActiveCell.Offset(1, 0).Select

'end if

End If

Next rcell2

I have 3 if tests outside of the above. My intention was to iterate through
a series of rows, looking for a border on top, and a border on the bottom,
after an undefined number of rows.

Once it finds the rows, I want to select them, and merge them.

However, in the case of my present macro, it merges, iterates through a
second set of rows, and selects the first set, and then selects, and merges
the second set with the first set.

This does not work.

My thinking at this point is that the rcell1 variable has the first row's
location still stored in its buffer, and if this indeed the case, I need the
rcell1 buffer emptied, to start with a new row location.

The problem is-- I'm not clear on how this is done. Anyone know how to do
this?

Thank you.

 

[Steve]

Hi Dave,
Ok, so are you saying I should select an entire range, and then use this
code to iterate through, looking for borders, and it should only merge the
ranges with borders at top and bottom?

I'd loop through the rows (not the selection).

Dim iRow as long
dim FirstRow as long
dim LastRow as long

dim TopCell as range
dim BotCell as range

with activesheet
firstrow = 1
lastrow = .cells(.rows.count,"A").end(xlup).row 'or whatever you want

for irow = firstrow to lastrow
if .cells(irow,"A")..Borders(xlEdgeTop).LineStyle = xlSolid then
set topcell = .cells(irow,"A")
set botcell = nothing 'start looking
else
if .cells(irow,"A").borders(xledgebottom).linestyle = xlsolid then
if topcell is nothing then
'keep looking, because we're not in a "group"
else
set botcell = .cells(irow,"A")
with .range(topcell,botcell)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
'get ready to start looking again
set topcell = nothing
set botcell = nothing
end if
end if
end if
next irow
end with

untested, uncompiled. Watch out for typos.

I used column A to look for those borders.

Morning all.

Let's see.... I've modified an existing macro to test for borders, and to
merge the selected cells.

My If test appears to work ok, but my core operation doesn't.

My code is:

For Each rcell2 In Selection

If rcell2.Borders(xlEdgeBottom).LineStyle = xlSolid Then

ActiveSheet.Range(rcell1, rcell2).Select

With Selection

.Merge

.VerticalAlignment = xlCenter

.HorizontalAlignment = xlCenter

End With

'Set rcell1 = Nothing

'Set rcell2 = Nothing

ActiveCell.Offset(1, 0).Select

'end if

End If

Next rcell2

I have 3 if tests outside of the above. My intention was to iterate through
a series of rows, looking for a border on top, and a border on the bottom,
after an undefined number of rows.

Once it finds the rows, I want to select them, and merge them.

However, in the case of my present macro, it merges, iterates through a
second set of rows, and selects the first set, and then selects, and merges
the second set with the first set.

This does not work.

My thinking at this point is that the rcell1 variable has the first row's
location still stored in its buffer, and if this indeed the case, I need the
rcell1 buffer emptied, to start with a new row location.

The problem is-- I'm not clear on how this is done. Anyone know how to do
this?

Thank you.

 

[Dave Peterson]

Nope.

I'm saying that you should figure out the first and last row and change that in
the code--unless it can determine it based on something else.

And I'm saying that you'll have to change the column to what you need--I used
column A.

Hi Dave,
Ok, so are you saying I should select an entire range, and then use this
code to iterate through, looking for borders, and it should only merge the
ranges with borders at top and bottom?

I'd loop through the rows (not the selection).

Dim iRow as long
dim FirstRow as long
dim LastRow as long

dim TopCell as range
dim BotCell as range

with activesheet
firstrow = 1
lastrow = .cells(.rows.count,"A").end(xlup).row 'or whatever you want

for irow = firstrow to lastrow
if .cells(irow,"A")..Borders(xlEdgeTop).LineStyle = xlSolid then
set topcell = .cells(irow,"A")
set botcell = nothing 'start looking
else
if .cells(irow,"A").borders(xledgebottom).linestyle = xlsolid then
if topcell is nothing then
'keep looking, because we're not in a "group"
else
set botcell = .cells(irow,"A")
with .range(topcell,botcell)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
'get ready to start looking again
set topcell = nothing
set botcell = nothing
end if
end if
end if
next irow
end with

untested, uncompiled. Watch out for typos.

I used column A to look for those borders.

Morning all.

Let's see.... I've modified an existing macro to test for borders, and to
merge the selected cells.

My If test appears to work ok, but my core operation doesn't.

My code is:

For Each rcell2 In Selection

If rcell2.Borders(xlEdgeBottom).LineStyle = xlSolid Then

ActiveSheet.Range(rcell1, rcell2).Select

With Selection

.Merge

.VerticalAlignment = xlCenter

.HorizontalAlignment = xlCenter

End With

'Set rcell1 = Nothing

'Set rcell2 = Nothing

ActiveCell.Offset(1, 0).Select

'end if

End If

Next rcell2

I have 3 if tests outside of the above. My intention was to iterate through
a series of rows, looking for a border on top, and a border on the bottom,
after an undefined number of rows.

Once it finds the rows, I want to select them, and merge them.

However, in the case of my present macro, it merges, iterates through a
second set of rows, and selects the first set, and then selects, and merges
the second set with the first set.

This does not work.

My thinking at this point is that the rcell1 variable has the first row's
location still stored in its buffer, and if this indeed the case, I need the
rcell1 buffer emptied, to start with a new row location.

The problem is-- I'm not clear on how this is done. Anyone know how to do
this?

Thank you.

 

[Steve]

Ok, column A, I'm fine with.
Not an issue.
It's the something else, with the first and last rows that I'm stuck on.
Let's revisit this on Monday. All my code is at the office, and I'm posting
from home now.
I'm hoping that something will gel with this in my mind over the weekend.

 

[Dave Peterson]

In the code I suggested, I used this:

with Activesheet
firstrow = 1
lastrow = .cells(.rows.count,"A").end(xlup).row 'or whatever you want

The firstrow was always 1
The lastrow is the lastrow in column A that has something in it.

(just an explanation that may help you on Monday)

 

[Steve]

So as to ensure that this doesn't get lost from last Friday....

Dave Peterson writes:
In the code I suggested, I used this:

with Activesheet
firstrow = 1
lastrow = .cells(.rows.count,"A").end(xlup).row 'or whatever you want

The firstrow was always 1
The lastrow is the lastrow in column A that has something in it.

(just an explanation that may help you on Monday)


Ok, this is a working macro.
Below is the code for future reference-- for when someone like me comes
along and needs a similar macro.....

I made some modifications because of some issues I found that were counter
productive to what I needed.
1- I set my start and end rows/columns to hard values, because the use of a
variable made it look all the way out to the end of the rows, and columns...
2^20 rows, and 16*2^10 columns. While a great thing to keep handy, it was
looking at more than I needed for now.

2- I added a column subst as well because I wanted it to look through all of
the columns with matching criteria, and process the rows accordingly.

3- while a future rendition, I'll next add a worksheet iterator as well.
This way I'll be able to process an entire workbook without having to
manually go through each sheet. Again-- in the future.

Dave, thank you so much for your help...!
Sub BorderLoops()

Dim iRow As Long
Dim iCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim TopCell As Range
Dim BotCell As Range
'----------------------------------------
'With ActiveSheet
' FirstRow = 1
' LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'or whatever you want
'
'The firstrow was always 1
'The lastrow is the lastrow in column A that has something in it.
'
'(just an explanation that may help you on Monday)
'
'----------------------------------------


With ActiveSheet
FirstRow = 8
LastRow = 67 '250
FirstCol = 18
LastCol = 25 '.Cells(FirstRow, .Columns.Count).End(xlToRight).Column
'test run

For iCol = FirstCol To LastCol
For iRow = FirstRow To LastRow
If .Cells(iRow, iCol).Borders(xlEdgeTop).LineStyle = xlSolid Then
'Or xlDouble
Set TopCell = .Cells(iRow, iCol)
Set BotCell = Nothing 'start looking
Else
If .Cells(iRow, iCol).Borders(xlEdgeBottom).LineStyle = xlSolid Then
If TopCell Is Nothing Then
'keep looking, because we're not in a "group"
Else
Set BotCell = .Cells(iRow, iCol)
With .Range(TopCell, BotCell)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
'get ready to start looking again
Set TopCell = Nothing
Set BotCell = Nothing
End If
End If
End If
Next iRow
Next iCol
End With
End Sub