VBA to check for same account and move all data to one row

Posted on 2012-09-04
Last Modified: 2012-09-06

I currently have a excel sheet that has an account number name and tel number amongst other columns.
For many of the account numbers, there will be multiple rows for a husband and wife of tel numbers.

I need to be able to move all the phone numbers for each account into one row and be able to identify who the account should go to.

I know if my head what the code should be , but cant seem to figure out how to actually write the code.

The code should look at Column A2  if the value is the same as the row above move column C and E to the same row as the first.. then move to the next row, if it is the same as above or above above, move the  rows.... Also it should label the primary row

I have attached a sample along with what the output should be ( modifications are shown in red)

Any help would be great
Question by:neoptoent
    1 Comment
    LVL 10

    Accepted Solution

    Here's a subroutine to merge the data:
    Sub MergeAccounts()
    Dim acct As Range
    Dim lastRow As Long
    Dim n As Long
        ActiveSheet.Range("H1").Value = "primary"
        Set acct = ActiveSheet.Range("A2")
        lastRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
        Do While acct.Row < lastRow
            acct.Cells(1, 8).Value = "yes"
            For n = 1 To lastRow - acct.Row
                If LCase(acct.Cells(n + 1, 1).Value) = LCase(acct.Value) Then
                    acct.Cells(n + 1, 8).Value = "no"
                    ' Copy the name
                    ActiveSheet.Cells(1, 9 + (n - 1) * 2).Value = "name" & (n + 1)
                    acct.Cells(1, 9 + (n - 1) * 2).Value = acct.Cells(n + 1, 3).Value
                    ' Copy the telephone number
                    ActiveSheet.Cells(1, 10 + (n - 1) * 2).Value = "tel" & (n + 1)
                    ActiveSheet.Cells(1, 10 + (n - 1) * 2).ColumnWidth = acct.Cells(n + 1, 5).ColumnWidth
                    acct.Cells(1, 10 + (n - 1) * 2).Value = acct.Cells(n + 1, 5).Value
                    Exit For
                End If
            Next n
            Set acct = acct.Cells(n + 1, 1)
    End Sub

    Open in new window


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
    Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
    This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
    This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    12 Experts available now in Live!

    Get 1:1 Help Now