• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 405
  • Last Modified:

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

Hi,

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
testdata.xlsx
testdataresult.xlsx
0
neoptoent
Asked:
neoptoent
1 Solution
 
tdlewisCommented:
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
            Else
                Exit For
            End If
        Next n
        Set acct = acct.Cells(n + 1, 1)
    Loop
End Sub

Open in new window

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now