Create Phone Number list with multiple groups

cjackson10111

New Member
Joined
Feb 10, 2014
Messages
2
I have a list of names/ phone numbers which is formatted as:
FirstLastPhone 1Phone 2AllChoirYouthetc.
JohnSmith910-111-1111910-111-1112xx
SaraGreen910-111-1113xx

<tbody>
</tbody>





All phone numbers are part of the "all" category (would be glad to delete if possible)
John Smith is a part of the list "all" and list "choir"
Sara Green is a part of list "all" and list "youth"

This information is used for a One Call system which sends out a phone call simultaneously to any of the groups selected. The company which manages this system requires the information to be sent to them in the format:

All
(910) 111-1111
(910) 111-1112
(910) 111-1113

Choir
(910) 111-1111
(910) 111-1112

Youth
(910) 111-1113

I would like to generate a table which compiles all of the numbers (about 300) into the list which will be sent to our One Call system.

I recently created a pivot table which creates this list, however it required the original table to be modified to:

FirstLastPhone 1Phone 2Definition
JohnSmith(910) 111-1111 (910) 111-1112 All
SaraGreen (910) 111-1113 All
JohnSmith (910) 111-1111(910) 111-1112 Choir
Sara Green (910) 111-1113 Youth

<tbody>
</tbody>

This solution would require any persons involved in several groups to have duplicate entries for each group.


I had considered creating several "Definition" columns and a series of pivot tables; one for Definition 2: Youth, one for Definition 3: Youth, one for Definition 2: Choir; one for Definition 3: Choir, etc.

This seems like it may not be necessary, but it would generate the list I need, if I can generate several pivot tables whose location is relative to the table above it, which I have been unable to figure out.

Office 2010
Windows 7
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
cjackson10111,

Welcome to the MrExcel forum.

What version of Excel and Windows are you using?

If I understand you correctly. With your raw data in Sheet1, with columns for First, Last, and, two phone number columns, and, then to the right multiple columns with text titles.

Sample raw data in worksheet Sheet1:


Excel 2007
ABCDEFG
1FirstLastPhone 1Phone 2AllChoirYouth
2JohnSmith910-111-1111910-111-1112xx
3SaraGreen910-111-1113xx
4
Sheet1


After the macro (using two arrays in memory) in a new worksheet On Call:


Excel 2007
A
1All
2910-111-1111
3910-111-1112
4910-111-1113
5
6Choir
7910-111-1111
8910-111-1112
9
10Youth
11910-111-1113
12
On Call


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Option Explicit
Sub ReorgData()
' hiker95, 02/10/2014, ME756719
Dim a As Variant, o As Variant
Dim i As Long, ii As Long
Dim lr As Long, lc As Long, n As Long
Dim c1 As Long, c2 As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = UBound(a, 1) * UBound(a, 2)
  ReDim o(1 To n, 1 To 1)
End With
For c2 = 5 To lc
  For i = LBound(a, 1) To UBound(a, 1)
    If i = 1 Then
      ii = ii + 1
      o(ii, 1) = a(1, c2)
    Else
      If a(i, c2) = "x" Then
        For c1 = 3 To 4
          If a(i, c1) <> "" Then
            ii = ii + 1
            o(ii, 1) = a(i, c1)
          End If
        Next c1
      End If
    End If
  Next i
  ii = ii + 1
Next c2
If Not Evaluate("ISREF('On Call'!A1)") Then Worksheets.Add().Name = "On Call"
With Sheets("On Call")
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.
 
Upvote 0
cjackson10111,

The below macro will create the resulting worksheet name of One Call

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Option Explicit
Sub ReorgDataV2()
' hiker95, 02/10/2014, ME756719
Dim a As Variant, o As Variant
Dim i As Long, ii As Long
Dim lr As Long, lc As Long, n As Long
Dim c1 As Long, c2 As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = UBound(a, 1) * UBound(a, 2)
  ReDim o(1 To n, 1 To 1)
End With
For c2 = 5 To lc
  For i = LBound(a, 1) To UBound(a, 1)
    If i = 1 Then
      ii = ii + 1
      o(ii, 1) = a(1, c2)
    Else
      If a(i, c2) = "x" Then
        For c1 = 3 To 4
          If a(i, c1) <> "" Then
            ii = ii + 1
            o(ii, 1) = a(i, c1)
          End If
        Next c1
      End If
    End If
  Next i
  ii = ii + 1
Next c2
If Not Evaluate("ISREF('One Call'!A1)") Then Worksheets.Add().Name = "One Call"
With Sheets("One Call")
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgDataV2 macro.
 
Upvote 0
Thanks hiker95,

I am running Windows 7 and Excel 2010.
The macro did not return any results, but that is probably my fault. My example was actually an abbreviated version of the spreadsheet. The actual sheet contains columns:
First NameLast NameExternal IDPhone 1Ext 1Desc 1Phone 2Ext 2Desc 21|All 2|Adult Choir 3|Keen-Agers4|Youth5|Children6|Faithful Voices7|Susie's *******8|Admin Council9|Nursery Workers

<tbody>
</tbody>

<tbody>
</tbody>

I still need the same information in the final sheet. I can make the changes to the macro myself (though I don't have any experience) if you can point me toward some instructions on macro-building and tell me the line where changes need to be made to the macro you sent.
Thanks again
 
Upvote 0
cjackson10111,

It is always best to display your actual raw data worksheet(s), and, the results that you are looking for. This way we can usually find a solution on the first go.

In order to continue, based on your last screenshot that had many columns, but, it did not have any data, you can make your workbook/worksheets available to us - see below:

You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top