#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,814
Default merge cells

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:



Code:
 

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.

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default merge cells

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.



Steve wrote:

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:

Code:
 
 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
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,814
Default merge cells

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?




"Dave Peterson" wrote:

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.



Steve wrote:

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:

Code:
  
  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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default merge cells

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.



Steve wrote:

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?

"Dave Peterson" wrote:

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.



Steve wrote:

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:

Code:
  
   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


--

Dave Peterson
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,814
Default merge cells

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" wrote:

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.



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default merge cells

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 wrote:

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" wrote:

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.


--

Dave Peterson
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,814
Default merge cells

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


"Dave Peterson" wrote:

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 wrote:

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" wrote:

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.


--

Dave Peterson

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Automatically merge mulitiple cells to one cells Edward Wang Excel Worksheet Functions 5 September 15th 09 07:56 PM
Select Merged Cells and Unmerge Spread Merge Data To All Cells rtwiss via OfficeKB.com Excel Programming 2 October 2nd 08 04:24 AM
how do I merge cells into one then delete the original cells? LLR Excel Worksheet Functions 2 March 7th 08 10:59 PM
How can I have formatting options like merge cells ,Bold,active for the unlocked cells of the protected worksheet.Is it possible in excel? divya Excel Programming 2 July 20th 06 02:04 PM
How do I merge cells in Excel, like just 2 cells to make one big . chattacat Excel Discussion (Misc queries) 2 January 19th 05 04:25 PM


All times are GMT +1. The time now is 08:13 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"