Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge Cells Logic
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 Logic
Brian
Try the below macro..with your data in ColA. It should merge and writ the data in ColB. Separator used is space. change if needed to suit your requirement.. Sub Macro() Dim lngRow As Long, lngNRow As Long, strData As String For lngRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row If WorksheetFunction.IsText(Range("A" & lngRow)) Then If Trim(strData) < "" Then _ lngNRow = lngNRow + 1: Range("B" & lngNRow) = Trim(strData) strData = Range("A" & lngRow) Else strData = strData & " " & Range("A" & lngRow) End If Next Range("B" & lngNRow + 1) = Trim(strData) End Sub If this post helps click Yes --------------- Jacob Skaria "Brian B" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge Cells Logic
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge Cells Logic
Hi; intially i though to merge th data. The below will merge the cells
Sub Macro() Dim lngRow As Long, lngSRow As Long For lngRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row If WorksheetFunction.IsText(Range("A" & lngRow)) Then If lngSRow < 0 Then Range("A" & lngSRow & ":A" & lngRow - 1).Cells.Merge End If lngSRow = lngRow End If Next Range("A" & lngSRow & ":A" & lngRow).Cells.Merge End Sub If this post helps click Yes --------------- Jacob Skaria "Jacob Skaria" wrote: Brian Try the below macro..with your data in ColA. It should merge and writ the data in ColB. Separator used is space. change if needed to suit your requirement.. Sub Macro() Dim lngRow As Long, lngNRow As Long, strData As String For lngRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row If WorksheetFunction.IsText(Range("A" & lngRow)) Then If Trim(strData) < "" Then _ lngNRow = lngNRow + 1: Range("B" & lngNRow) = Trim(strData) strData = Range("A" & lngRow) Else strData = strData & " " & Range("A" & lngRow) End If Next Range("B" & lngNRow + 1) = Trim(strData) End Sub If this post helps click Yes --------------- Jacob Skaria "Brian B" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge Cells Logic
Thanks very much Jacob, for the help.
What I'd like to do is take the code you've provided and make it work for a User Selectable number of Columns. I haven't had much luck with it, which means I don't understand the logic/syntax of what you wrote sufficiently. Here's my edit to the code that doesn't compile: (notice it includes Two examples of translating the # of Columns to a Column Header letter). Dim inputColumn As Integer inputColumn = InputBox("How many levels of requirements did this report account for?", "Requirement Levels") inputColumn = inputColumn * 2 ' Hide the Columns between Originating and End Leaf Dim ColMod As Integer Dim MyColNum As Integer Dim intInt As Integer Dim ConvertCol As Variant Dim currentColumn As Integer MyColNum = inputColumn '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) Dim lngRow As Long, lngSRow As Long For ColumnCount = 1 To inputColumn currentColumn = ColumnCount 'Figure out the Letter for the Column Dim ColMod2 As Integer Dim MyColNum2 As Integer Dim intInt2 As Integer Dim ConvertCol2 As Variant Dim currentColumn2 As Integer RowMax = ActiveSheet.UsedRange.Rows.Count MyColNum2 = currentColumn ColMod2 = MyColNum2 Mod 26 'div column # by 26. Remainder is the_Second letter If ColMod2 = 0 Then 'if no remainder then fix value ColMod2 = 26 MyColNum2 = MyColNum2 - 26 End If intInt2 = MyColNum2 \ 26 'first letter If intInt2 = 0 Then ConvertCol2 = Chr(ColMod2 + 64) Else _ ConvertCol2 = Chr(intInt2 + 64) & Chr(ColMod2 + 64) For lngRow = 1 To RowMax = ActiveSheet.UsedRange.Rows.Count If WorksheetFunction.IsText(Range(ConvertCol2 & lngRow)) Then If lngSRow < 0 Then Range(ConvertCol2 & lngSRow & ":" & ConvertCol2 & lngRow - 1).Cells.Merge End If lngSRow = lngRow End If Next Range(ConvertCol2 & lngSRow & ":" & ConvertCol2 & lngRow).Cells.Merge Next ColumnCount End Sub "Jacob Skaria" wrote: Hi; intially i though to merge th data. The below will merge the cells Sub Macro() Dim lngRow As Long, lngSRow As Long For lngRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row If WorksheetFunction.IsText(Range("A" & lngRow)) Then If lngSRow < 0 Then Range("A" & lngSRow & ":A" & lngRow - 1).Cells.Merge End If lngSRow = lngRow End If Next Range("A" & lngSRow & ":A" & lngRow).Cells.Merge End Sub If this post helps click Yes --------------- Jacob Skaria "Jacob Skaria" wrote: Brian Try the below macro..with your data in ColA. It should merge and writ the data in ColB. Separator used is space. change if needed to suit your requirement.. Sub Macro() Dim lngRow As Long, lngNRow As Long, strData As String For lngRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row If WorksheetFunction.IsText(Range("A" & lngRow)) Then If Trim(strData) < "" Then _ lngNRow = lngNRow + 1: Range("B" & lngNRow) = Trim(strData) strData = Range("A" & lngRow) Else strData = strData & " " & Range("A" & lngRow) End If Next Range("B" & lngNRow + 1) = Trim(strData) End Sub If this post helps click Yes --------------- Jacob Skaria "Brian B" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge Cells Logic
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. 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 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 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 | |||
Automatically merge mulitiple cells to one cells | Excel Worksheet Functions | |||
Select Merged Cells and Unmerge Spread Merge Data To All Cells | Excel Programming | |||
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 | |||
Average of logic cells | Excel Discussion (Misc queries) | |||
Anyone know how to format cells as yes/no boolean logic? | New Users to Excel |