Excel Scripting Help

Microsoft Excel 2007
October 29, 2009 at 09:26:52
Specs: Windows XP
Hello, I am looking for an excel VBA script that scans my worksheet and will combine rows based on a duplicate value of a field. I have a customer spreadsheet with about 2000 customers that I export from my sales database. It puts all of their phone numbers in column a, and customer IDs in column b. My database distinguishes whether the phone number is a mobile, home or business by leading the number with a m, h, or b before the number, I would have, for example, b (123)555-1212 for a business number. I can quickly sort column A and then move the phone numbers so that business, home and mobile each have their own column, then sort by customer ID and I have three entries of phone numbers for each unique customer ID. I'm looking for a script that will merge/combine rows based on the customer ID so that business, mobile and home numbers are all on the same row and the three unique customer IDs become just one, giving me one each customer and not three. Can anyone help?

See More: Excel Scripting Help

Report •

October 30, 2009 at 04:48:08

I have written a short macro which I think does what you want.

It takes a list which consists of phone numbers (prefixed with a letter) in one column and a customer ID in the second column.

It sorts the database by ID, then copies the data to a second worksheet.
The data is presented as Customer ID followed by three columns, one column for each type of phone number, based on the initial m, h or b

Here is my dummy data base:
The header is in Row 1 with 'Phone #' in cell A1 and 'ID' in B1

Phone #	ID
m3929	4
b4961	5
h3861	2
m1851	8
b2932	2
h3567	9
h1652	4
m1227	3
b1355	4
b2724	6
h3496	1
m3263	1
h1138	8
b4049	3
b1201	9
m2472	2
h4875	7
h1389	6
b3322	1
m1153	6
m1205	7
m2209	5

and here is the sorted output:

ID	Ph #1	Ph #2	Ph #3
1	m3263	h3496	b3322
2	m2472	h3861	b2932
3	m1227		b4049
4	m3929	h1652	b1355
5	m2209		b4961
6	m1153	h1389	b2724
7	m1205	h4875	
8	m1851	h1138	
9		h3567	b1201

The following code goes in a standard VBA module

Option Explicit

Sub PhoneSort()
Dim rngDB As Range
Dim rngCell As Range
Dim strThisOne As String
Dim m, n, p, q As Integer

With ActiveWorkbook.Worksheets("Source")
    'sort the data into order
    .Range("A1:B23").Sort _
        Key1:=.Range("B1"), _
        Header:=xlYes, _

    'get first ID
    strThisOne = .Range("B2").Text
    n = 0
    p = 0
    'loop through the database range
    'including one blank row at end
    For Each rngCell In .Range("B2:B24")
        If rngCell.Text = strThisOne Then
            'same ID as last one
            n = n + 1
            'different ID to last one
            'so lets move some data
            'move the ID
            rngCell.Offset(-1, 0).Copy _
                Destination:=Worksheets("Destination").Range("A2").Offset(p, 0)
            'move the phone number(s)
            For m = 1 To n
                If Left(rngCell.Offset(-m, -1).Text, 1) = "m" Then q = 1
                If Left(rngCell.Offset(-m, -1).Text, 1) = "h" Then q = 2
                If Left(rngCell.Offset(-m, -1).Text, 1) = "b" Then q = 3
                rngCell.Offset(-m, -1).Copy _
                    Destination:=Worksheets("Destination").Range("A2").Offset(p, q)
            Next m
            p = p + 1
            n = 1
        End If
        strThisOne = rngCell.Text
    Next rngCell
End With
End Sub

The code is pretty basic, and as the ranges are 'hardcoded' it would have to be customized for your database and changed as the database gets bigger.

The use of named ranges would get round this issue. If this works, then it could be modified to use named ranges, removing the need to change the code when the database changes size.

The example has the unsorted data on a worksheet named "Source" in the range A2 to B23 with headers in row 1 and the output goes to a worksheet named "Destination"

As this has not been tested with your data/on your setup, please ensure that all data is backed up, and the code is tested on a duplicate set of data. I have only carried out basic tests which show that the code works on the test data shown above.


Report •
Related Solutions

Ask Question