Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Select Merged Cells and Unmerge Spread Merge Data To All Cells | Excel Programming | |||
how do I merge cells into one then delete the original cells? | Excel Worksheet Functions | |||
Connection between size and complexity | Excel Worksheet Functions | |||
How can I have formatting options like merge cells ,Bold,active for the unlocked cells of the protected worksheet.Is it possible in excel? | Excel Programming | |||
Excel 2007 Charts Complexity | Charts and Charting in Excel |