C
Carrie_Loos via OfficeKB.com
I have this code that someone helped me with and it works great except the
message "The selection contains multiple data values. Merging into one celll
will keep the upper left most data only" message. I have to answer "OK" in
order for the code to continue to loop. Does anyone know a way to get around
this in the code?
Sub MergeCells()
ActiveCell.Activate
RowCount = ActiveCell.Row
ColCount = 1
Do While Cells(RowCount, ColCount) <> ""
If Cells(RowCount, ColCount) = 1 Then
StartCol = ColCount
Data = 1
Do While Cells(RowCount, ColCount) = 1 And _
Cells(RowCount, (ColCount + 1)) = 1
ColCount = ColCount + 1
Data = Data & " 1"
Loop
Range(Cells(RowCount, StartCol), _
Cells(RowCount, ColCount)). _
MergeCells = True
Cells(RowCount, StartCol) = Data
On Error Resume Next
End If
ColCount = ColCount + 1
Loop
ActiveCell.Offset(1, 0).Activate
End Sub
Thanks
Carrie
message "The selection contains multiple data values. Merging into one celll
will keep the upper left most data only" message. I have to answer "OK" in
order for the code to continue to loop. Does anyone know a way to get around
this in the code?
Sub MergeCells()
ActiveCell.Activate
RowCount = ActiveCell.Row
ColCount = 1
Do While Cells(RowCount, ColCount) <> ""
If Cells(RowCount, ColCount) = 1 Then
StartCol = ColCount
Data = 1
Do While Cells(RowCount, ColCount) = 1 And _
Cells(RowCount, (ColCount + 1)) = 1
ColCount = ColCount + 1
Data = Data & " 1"
Loop
Range(Cells(RowCount, StartCol), _
Cells(RowCount, ColCount)). _
MergeCells = True
Cells(RowCount, StartCol) = Data
On Error Resume Next
End If
ColCount = ColCount + 1
Loop
ActiveCell.Offset(1, 0).Activate
End Sub
Thanks
Carrie