ExcelBanter - Merging cell using VB for Excel

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Merging cell using VB for Excel (https://www.excelbanter.com/excel-programming/404302-merging-cell-using-vbulletin-excel.html)

Merging cell using VB for Excel

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 posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200801/1

Merging cell using VB for Excel

Try wrapping the merging part of your code in

Application.EnableEvents = False
' merge here
Application.EnableEvents = True

HTH,
JP

On Jan 15, 3:15*pm, "Carrie_Loos via OfficeKB.com" <u34134@uwe wrote:
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 posted via OfficeKB.comhttp://www.officekb.com/Uwe/Forums.aspx/excel-programming/200801/1

Merging cell using VB for Excel

I'm probably wrong, but I think you could use the following (which may be
what JP meant? -- or will they both work?):

Application.DisplayAlerts = False
<merge here
Application.DisplayAlerts = True

"Carrie_Loos via OfficeKB.com" wrote:

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 posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200801/1

Merging cell using VB for Excel

That's what I meant, had my wires crossed.

Thx,
JP

On Jan 15, 3:42*pm, XP wrote:
I'm probably wrong, but I think you could use the following (which may be
what JP meant? -- or will they both work?):

Application.DisplayAlerts = False
<merge here
Application.DisplayAlerts = True

"Carrie_Loos via OfficeKB.com" wrote:
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 posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...ming/200801/1- Hide quoted text -

- Show quoted text -

Merging cell using VB for Excel

Works great thanks!

JP wrote:
That's what I meant, had my wires crossed.

Thx,
JP

I'm probably wrong, but I think you could use the following (which may be
what JP meant? -- or will they both work?):
[quoted text clipped - 55 lines]

- Show quoted text -

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200801/1