Solved Merge duplicates with VBA (1 Viewer)

Cris VS

Member
Local time
Today, 19:36
Joined
Sep 16, 2021
Messages
75
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".

Code:
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

Well-known member
Local time
Today, 14:36
Joined
Apr 9, 2015
Messages
4,339
excel has a icon on the toolbar called REMOVE DUPLICATES.
does this not work?
 

Cris VS

Member
Local time
Today, 19:36
Joined
Sep 16, 2021
Messages
75
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

Super Moderator
Staff member
Local time
Today, 18:36
Joined
Feb 19, 2013
Messages
16,553
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

Member
Local time
Today, 19:36
Joined
Sep 16, 2021
Messages
75
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 userID computerComputer model
0123gh34Mac OS X xxx
987651fgMac OS X xxx
5698wgg5Windows...

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

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 02:36
Joined
May 7, 2009
Messages
19,169
Code:
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

Member
Local time
Today, 19:36
Joined
Sep 16, 2021
Messages
75
Code:
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
 

Users who are viewing this thread

Top Bottom