VBA macros that can move up data on different rows based on column A

[lihong3210]

Hi all,

Calling for help and hope VBA or macros can make my life easier. The below screenshot is the current file and I'm trying to eliminate as much duplicate rows on column A as possible. The file is showing mapping of local accounts (column C to I) and how it mapped to consolidated group accounts (column A & B). Is there a way to move E173 to E172 and F174 to F172 to get rid of row 173 and row 174? The file has over 3000 rows and I just want to make them automated instead doing one by one.

Greatly appreciate if someone can help!

 

[eiloken]

if all duplicate values in column A always continues then this will work:

Sub MoveRows()
    Dim cll As Range, rng As Range
    Dim lr As Long
    Dim xcll As Range
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    If lr < 2 Then Exit Sub
    Set rng = Range("A2:A" & lr)
    For Each cll In rng
        If Not IsEmpty(cll) Then
            If xcll Is Nothing Then Set xcll = cll
            If cll.Value = xcll.Value Then
                If Not IsEmpty(cll.Offset(, 4)) Then
                    xcll.Offset(, 4).Value = cll.Offset(, 4).Value
                    cll.Offset(, 4).Value = Empty
                End If
                If Not IsEmpty(cll.Offset(, 5)) Then
                    xcll.Offset(, 5).Value = cll.Offset(, 5).Value
                    cll.Offset(, 5).Value = Empty
                End If
            Else
                Set xcll = cll
            End If
        End If
    Next cll
End Sub

 

[lihong3210]

if all duplicate values in column A always continues then this will work:

Sub MoveRows()
    Dim cll As Range, rng As Range
    Dim lr As Long
    Dim xcll As Range
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    If lr < 2 Then Exit Sub
    Set rng = Range("A2:A" & lr)
    For Each cll In rng
        If Not IsEmpty(cll) Then
            If xcll Is Nothing Then Set xcll = cll
            If cll.Value = xcll.Value Then
                If Not IsEmpty(cll.Offset(, 4)) Then
                    xcll.Offset(, 4).Value = cll.Offset(, 4).Value
                    cll.Offset(, 4).Value = Empty
                End If
                If Not IsEmpty(cll.Offset(, 5)) Then
                    xcll.Offset(, 5).Value = cll.Offset(, 5).Value
                    cll.Offset(, 5).Value = Empty
                End If
            Else
                Set xcll = cll
            End If
        End If
    Next cll
End Sub

Hi,

Thank you so much for helping me on this. The code works, however it only works from Column "C" to "F" and not for column "G to I", how do I adjust the code so that it also works for col "G" to "I"? In addition, would it be possible to delete the duplicate account if there are no values from column "C" to "I". For example, row#5 shown in the screenshot should be deleted as there are no values/input in col "C" through "I".

Thanks again for your help on this!