Solved Merge duplicates with VBA

[Cris VS]

Hello, I am trying to compare the value of a set of cells (rows 85 to 200 of column 5), so that if they have the same value the cells get merged. I have tried this code but it doesn't work. This is part of a code that exports some queries using CopyFromRecordest, so this loop is inside the corresponding "with xlSheet".

For nrow = 85 To 200
                If .Cells(nrow, 5) <> .Cells(nrow + 1, 5) Then
                    With .Range(.Cells(nrow, 5) & "," & .Cells(nrow + 1, 5))
                        .Merge
                        .HorizontalAlignment = xlCenterAcrossSelection
                        .VerticalAlignment = xlCenter
                    End With
                    nrow = nrow + 1
                End If
            Next nrow

Could someone give me a hand?

Thanks a lot

 

[Ranman256]

excel has a icon on the toolbar called REMOVE DUPLICATES.
does this not work?

 

[Cris VS]

excel has a icon on the toolbar called REMOVE DUPLICATES.
does this not work?

Sorry I didn't specify this. I am exporting query from Access to Excel so I want to merge the duplicates with VBA so that the user gets the proper output without having to edit the Excel

 

[CJ_London]

I am exporting query from Access to Excel so I want to merge the duplicates with VBA

should need VBA, set your query to 'SELECT DISTINCT' rather than just 'SELECT'

 

[Cris VS]

should need VBA, set your query to 'SELECT DISTINCT' rather than just 'SELECT'

I don't think I can choose that because my records are distinct - it is only that field that is repeated. Let me put an example with the following table, which would be my query:

ID user	ID computer	Computer model
0123	gh34	Mac OS X xxx
9876	51fg	Mac OS X xxx
5698	wgg5	Windows...

I would like to have my Excel look like this but with the two "Mac OS X xxx" cells merged.

 

[arnelgp]

Dim x As String
Dim y As String
Dim nrow As Long
Dim adr As String
x = ""
Application.DisplayAlerts = False
With ActiveSheet
    For nrow = 85 To 200
        y = .Cells(nrow, 5) & ""
        If Len(y) Then
            If y = x Then
                adr = .Cells(nrow - 1, 5).Address & ":" & .Cells(nrow, 5).Address
                .Range(adr).Select
                With Selection
                    .Merge
                    .HorizontalAlignment = xlCenterAcrossSelection
                    .VerticalAlignment = xlCenter
                End With
            End If
        End If
        x = y
    Next nrow
End With
Application.DisplayAlerts = True

 

[Cris VS]

Dim x As String
Dim y As String
Dim nrow As Long
Dim adr As String
x = ""
Application.DisplayAlerts = False
With ActiveSheet
    For nrow = 85 To 200
        y = .Cells(nrow, 5) & ""
        If Len(y) Then
            If y = x Then
                adr = .Cells(nrow - 1, 5).Address & ":" & .Cells(nrow, 5).Address
                .Range(adr).Select
                With Selection
                    .Merge
                    .HorizontalAlignment = xlCenterAcrossSelection
                    .VerticalAlignment = xlCenter
                End With
            End If
        End If
        x = y
    Next nrow
End With
Application.DisplayAlerts = True

Just what I needed! I changed xlApp.DisplayAlerts to match the code I had and works perfectly