Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 14
Default Merge Cells Complexity

This is a response to the help that one of the MVP's gave me, but if anyone
else has any input, I'm all ears.

Normally I wouldn't be this persistent about one question, but this is the
last 'little hump' I have to get past to complete this project. I didn't
think vertical merging of cells in a spreadsheet would be this complicated,
but it turns out it is:

Here's the situation thus far:

[Thanks for your help Rick.

In the below I've tried to modify your code to allow for a User Input as far
as Which Columns are affected. Also, I've tried to make the amount of cell
merger consistent across the bottom row, i.e., if the spreadsheet's last row
is 1500, then all of the columns should "merge" down to row 1500...as opposed
to the current staggered merger from column to column. Some columns stop
merger at row 1300, others 1400, etc.

However, the following code doesn't work, so I was wondering if you had any
input to assist.

Thanks,
Brian

Code:
Sub MergeColumnsOfBlanks()

Dim Cols() As String
Dim X As Long, LastRow As Long
Dim BlankCells As Range, BlankRange As Range
Dim ColumnCount As Integer
Dim currentColumn As Integer

' I'm not using the below Const String assignment, b/c I want the range to
be _ selectable by the user
Const ColumnRange As String = "A,B,C,D,E,F,G,H"
Const StartRowForMerges As Long = 2
ColumnCount = InputBox("How many levels of Requirements did the Compliance
Matrix Account for?", "Requirement Levels")
ColumnCount = ColumnCount * 2
'not using Cols, b/c I want the Column range to be User-Selectable
Cols = Split(ColumnRange, ",")
On Error Resume Next
Application.ScreenUpdating = False
For X = 0 To ColumnCount
currentColumn = ColumnCount
MyColNum = currentColumn

'Translate Column header to usable letter as ConvertCol
ColMod = MyColNum Mod 26 'div column # by 26. Remainder is the_Second
letter
If ColMod = 0 Then 'if no remainder then fix value
ColMod = 26
MyColNum = MyColNum - 26
End If
intInt = MyColNum \ 26 'first letter
If intInt = 0 Then ConvertCol = Chr(ColMod + 64) Else _
ConvertCol = Chr(intInt + 64) & Chr(ColMod + 64)
' Here's where I tried to extend the merge to the bottom-most used row
LastRow = Cells(ActiveSheet.UsedRange.Rows.Count, Cols(X)).End(xlUp).row
Set BlankCells = Columns(ConvertCol(X)).SpecialCells(xlCellTypeBlan ks)
For Each BlankRange In BlankCells
If BlankRange.row StartRowForMerges And _
BlankRange.row < LastRow + 1 Then
BlankRange.Offset(-1).Resize(BlankRange.Rows.Count + 1).Merge
End If
Next
Next
Application.ScreenUpdating = True
End Sub

"Rick Rothstein" wrote:

Give the following macro a try. You can set the columns to be search in the
ColumnRange constant (Const) statement. In my example code, I set the merges
to take place in Columns A, B, C and E. I also started the merge after Row 2
(which is set in the StartRowForMerges constant).

Sub MergeColumnsOfBlanks()
Dim Cols() As String
Dim X As Long, LastRow As Long
Dim BlankCells As Range, BlankRange As Range
Const ColumnRange As String = "A,B,C,E"
Const StartRowForMerges As Long = 2
Cols = Split(ColumnRange, ",")
On Error Resume Next
Application.ScreenUpdating = False
For X = 0 To UBound(Cols)
LastRow = Cells(Rows.Count, Cols(X)).End(xlUp).Row
Set BlankCells = Columns(Cols(X)).SpecialCells(xlCellTypeBlanks)
For Each BlankRange In BlankCells
If BlankRange.Row StartRowForMerges And _
BlankRange.Row < LastRow + 1 Then
BlankRange.Offset(-1).Resize(BlankRange.Rows.Count + 1).Merge
End If
Next
Next
Application.ScreenUpdating = True
End Sub

--
Rick (MVP - Excel)


"Brian B" wrote in message
...
Hello,
I would like to be able to go RowXRow/Column and merge Cells vertically
based on the conditions that the first cell has text content, and the
subsequent cells do not.

This selection would progress downward/column until another cell that
contains Text was encountered, and then the gathered selection previous to
that 2nd cell with text was encountered, would be merged.

I'm thinking I should use a Boolean to = True when cells contain content,
and False when they do not, and Select cells based around that toggle.

Obviously this logic is a bit tricky for me to handle, so any help is
appreciated.

Thanks,
Brian


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Merge Cells Complexity

Sorry, I see now that I missed your follow up question to my last post in
your previous thread. I think the following will do what you want for the
"last row" part of your question. I had a little trouble following your
"which column" section of code that you added to what I posted originally
for you, so went back and just modified my original code to ask the user to
list the column letters in a comma delimited list. If I misunderstood what
you wanted for this part, just change it back to what you posted.

Sub MergeColumnsOfBlanks()
Dim X As Long, LastRow As Long
Dim ColumnRange As String, Cols() As String
Dim BlankCells As Range, BlankRange As Range
Const StartRowForMerges As Long = 2
LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious).Row
ColumnRange = Replace(InputBox("COMMA DELIMITED column list?"), " ", "")
Cols = Split(ColumnRange, ",")
On Error Resume Next
Application.ScreenUpdating = False
For X = 0 To UBound(Cols)
Set BlankCells = Columns(Cols(X)).SpecialCells(xlCellTypeBlanks)
For Each BlankRange In BlankCells
If BlankRange.Row StartRowForMerges And _
BlankRange.Row < LastRow + 1 Then
BlankRange.Offset(-1).Resize(BlankRange.Rows.Count + 1).Merge
End If
Next
Next
Application.ScreenUpdating = True
End Sub

--
Rick (MVP - Excel)


"Brian B" wrote in message
...
This is a response to the help that one of the MVP's gave me, but if
anyone
else has any input, I'm all ears.

Normally I wouldn't be this persistent about one question, but this is the
last 'little hump' I have to get past to complete this project. I didn't
think vertical merging of cells in a spreadsheet would be this
complicated,
but it turns out it is:

Here's the situation thus far:

[Thanks for your help Rick.

In the below I've tried to modify your code to allow for a User Input as
far
as Which Columns are affected. Also, I've tried to make the amount of
cell
merger consistent across the bottom row, i.e., if the spreadsheet's last
row
is 1500, then all of the columns should "merge" down to row 1500...as
opposed
to the current staggered merger from column to column. Some columns stop
merger at row 1300, others 1400, etc.

However, the following code doesn't work, so I was wondering if you had
any
input to assist.

Thanks,
Brian

Code:
Sub MergeColumnsOfBlanks()

Dim Cols() As String
Dim X As Long, LastRow As Long
Dim BlankCells As Range, BlankRange As Range
Dim ColumnCount As Integer
Dim currentColumn As Integer

' I'm not using the below Const String assignment, b/c I want the range to
be _ selectable by the user
Const ColumnRange As String = "A,B,C,D,E,F,G,H"
Const StartRowForMerges As Long = 2
ColumnCount = InputBox("How many levels of Requirements did the
Compliance
Matrix Account for?", "Requirement Levels")
ColumnCount = ColumnCount * 2
'not using Cols, b/c I want the Column range to be User-Selectable
Cols = Split(ColumnRange, ",")
On Error Resume Next
Application.ScreenUpdating = False
For X = 0 To ColumnCount
currentColumn = ColumnCount
MyColNum = currentColumn

'Translate Column header to usable letter as ConvertCol
ColMod = MyColNum Mod 26 'div column # by 26. Remainder is the_Second
letter
If ColMod = 0 Then 'if no remainder then fix value
ColMod = 26
MyColNum = MyColNum - 26
End If
intInt = MyColNum \ 26 'first letter
If intInt = 0 Then ConvertCol = Chr(ColMod + 64) Else _
ConvertCol = Chr(intInt + 64) & Chr(ColMod + 64)
' Here's where I tried to extend the merge to the bottom-most used row
LastRow = Cells(ActiveSheet.UsedRange.Rows.Count,
Cols(X)).End(xlUp).row
Set BlankCells = Columns(ConvertCol(X)).SpecialCells(xlCellTypeBlan ks)
For Each BlankRange In BlankCells
If BlankRange.row StartRowForMerges And _
BlankRange.row < LastRow + 1 Then
BlankRange.Offset(-1).Resize(BlankRange.Rows.Count + 1).Merge
End If
Next
Next
Application.ScreenUpdating = True
End Sub

"Rick Rothstein" wrote:

Give the following macro a try. You can set the columns to be search in
the
ColumnRange constant (Const) statement. In my example code, I set the
merges
to take place in Columns A, B, C and E. I also started the merge after
Row 2
(which is set in the StartRowForMerges constant).

Sub MergeColumnsOfBlanks()
Dim Cols() As String
Dim X As Long, LastRow As Long
Dim BlankCells As Range, BlankRange As Range
Const ColumnRange As String = "A,B,C,E"
Const StartRowForMerges As Long = 2
Cols = Split(ColumnRange, ",")
On Error Resume Next
Application.ScreenUpdating = False
For X = 0 To UBound(Cols)
LastRow = Cells(Rows.Count, Cols(X)).End(xlUp).Row
Set BlankCells = Columns(Cols(X)).SpecialCells(xlCellTypeBlanks)
For Each BlankRange In BlankCells
If BlankRange.Row StartRowForMerges And _
BlankRange.Row < LastRow + 1 Then
BlankRange.Offset(-1).Resize(BlankRange.Rows.Count + 1).Merge
End If
Next
Next
Application.ScreenUpdating = True
End Sub

--
Rick (MVP - Excel)


"Brian B" wrote in message
...
Hello,
I would like to be able to go RowXRow/Column and merge Cells vertically
based on the conditions that the first cell has text content, and the
subsequent cells do not.

This selection would progress downward/column until another cell that
contains Text was encountered, and then the gathered selection previous
to
that 2nd cell with text was encountered, would be merged.

I'm thinking I should use a Boolean to = True when cells contain
content,
and False when they do not, and Select cells based around that toggle.

Obviously this logic is a bit tricky for me to handle, so any help is
appreciated.

Thanks,
Brian



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
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
Connection between size and complexity emilija Excel Worksheet Functions 3 May 4th 07 07:57 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
Excel 2007 Charts Complexity Tintin Charts and Charting in Excel 2 June 6th 06 02:07 AM


All times are GMT +1. The time now is 01:33 PM.

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"