ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro for merging cells (https://www.excelbanter.com/excel-programming/355686-macro-merging-cells.html)

XLuser

Macro for merging cells
 

Hi,

I have a application that can export to XL.
This application also have the possibility to execute a XL macro after
the exporting is done. Using this "execute macro" function I would like
to merge cells that have the same data as the next row in the same
column and this should only be done in the 3 first columns. See the
attached bmp file for how it looks and should look.

I have searched the forum for examples without luck so I must turn to
you excel/macro wizards out there since I'm no programmer :confused: .

Thx in advance


+-------------------------------------------------------------------+
|Filename: Excelmacro.bmp |
|Download: http://www.excelforum.com/attachment.php?postid=4439 |
+-------------------------------------------------------------------+

--
XLuser
------------------------------------------------------------------------
XLuser's Profile: http://www.excelforum.com/member.php...o&userid=32347
View this thread: http://www.excelforum.com/showthread...hreadid=521094


XLuser

Macro for merging cells
 

Problem solved

I found an example published by Frank Kabel in Maj 2004 and with the
help of others here at the company we modified it some and came up with
this:


Code:
--------------------
Sub mergebycol()
Dim lastrow As Long
Dim row_index As Long
Dim col_index As Long
Dim start_index As Long
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
For col_index = 1 To 3
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
start_index = 1
For row_index = 2 To lastrow + 1
If .Cells(row_index, col_index).Value < .Cells(row_index - 1, col_index).Value Then
If row_index - start_index 1 Then
Application.DisplayAlerts = False
With Range(.Cells(start_index, col_index), .Cells(row_index - 1, col_index))
.Merge
.VerticalAlignment = xlCenter
End With
Application.DisplayAlerts = True
End If
start_index = row_index
End If
Next
Next
End With
End Sub
--------------------


--
XLuser
------------------------------------------------------------------------
XLuser's Profile: http://www.excelforum.com/member.php...o&userid=32347
View this thread: http://www.excelforum.com/showthread...hreadid=521094



All times are GMT +1. The time now is 07:03 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com