Merge cells having same values

[Ehtisham Ali]

Hi VBA Champs,

Please refer to the attached file.

In col(A) I have incident numbers, now for those incident numbers which are same I want to merge cells in col(A) and also merge cells in col(B) to col(F).

Like I have done manually for INC000012911090 and INC000012974811.

I want a dynamic code so that there may be 56 row data now but later it may be less or greater.

Thanks in advanced.

 

[Asheesh]

Hi Ali,

Is it necessary to merge...you can even use pivot table for this...see the attached..

 

[Ehtisham Ali]

Hi Ali,

Is it necessary to merge...you can even use pivot table for this...see the attached..

Yes it is necessary to merge because my customer is not an excel champ. They only use excel to keep data aligned.

Hence they require a report in the merge cell format.

FYI: I have created a macro to fetch data on the basis of Incident Number from 3 different files to create the report file I had shared. Now the final step remaining is to merge cells for duplicate incidents.

 

[Ehtisham Ali]

Hello everyone,

I have come up with a code but it is not perfect. Please help

 

[NARAYANK991]

Hi Ali ,

See if this works.

At present , the merging is being done only in column A ; in reality this should be done in all the columns which you want merged ; you should not run this macro on each column independently.

Narayan

 

[Ehtisham Ali]

Hi Narayan Sir,

I have done with a code which does it all.
I am not sure about the quality of my code, any suggestions from your side is welcome.

Sub MergeIncidentNumbers()
Worksheets("workinfo_data").Activate 'TO ACTIVATE WORKSHEET CONTAINING DATA
'TO BYPASS MERGE CELL WARNING
Application.DisplayAlerts = False
n = Cells(Rows.Count, "a").End(xlUp).Row 'TO COUNT NUMBER OF ROWS IN DATA

Range("A2:E" & n).Sort key1:=Range("A2:A" & n), _
   order1:=xlAscending, Header:=xlYes


Count = 2 'COUNTER TO HOP FOR NEXT INCIDENT NUMBER
For i = 2 To n
If Range("a" & Count) = Range("a" & i) Then
'MERGE CELLS HAVING SAME INCIDENT NUMBER
Range("a" & Count & ":" & "a" & i).Select 'COL CONTAINING INCIDENT NUMBERS
Selection.Merge
Range("b" & Count & ":" & "b" & i).Select '/
Selection.Merge
Range("c" & Count & ":" & "c" & i).Select '/
Selection.Merge
Range("d" & Count & ":" & "d" & i).Select 'CELLS TO BE MERGE INDEPENDTLY FOR HAVING SAME INCIDENT NUMBERS
Selection.Merge
Range("e" & Count & ":" & "e" & i).Select '/
Selection.Merge
Range("f" & Count & ":" & "f" & i).Select '/
Selection.Merge
Else
Count = i 'TO MOVE TO NEXT INCIDENT NUMBER
End If
Next i
'TO SET ALIGNMENT OF CONTENTS WITHIN MERGRE CELLS
Columns("A:F").VerticalAlignment = xlCenter
End Sub

 

[NARAYANK991]

Hi Ali ,

Please see if the file I uploaded earlier works ; if it does , you can easily extend the merge to the associated columns.

Narayan

 

[jindon]

This should do

Sub test()
    Dim r As Range, i As Long
    Application.ScreenUpdating = False
    Columns(1).Insert
    With Range("b2", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
        .Formula = "=if(b1<>b2,if(a1=1,""a"",1),"""")"
        .Value = .Value
        On Error Resume Next
        .SpecialCells(2, 1).EntireRow.Insert
        .SpecialCells(2, 2).EntireRow.Insert
        On Error GoTo 0
    End With
    Application.DisplayAlerts = False
    For Each r In Columns(2).SpecialCells(2).Areas
        If (r.Rows.Count > 1) * (Not r.MergeCells) Then
            For i = 1 To 6
                r.Columns(i).Merge
            Next
        End If
    Next
    Application.DisplayAlerts = True
    Columns(1).Delete
    Range("g1", Range("g" & Rows.Count).End(xlUp)).SpecialCells(4).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub