Create Phone Number list with multiple groups

[cjackson10111]

I have a list of names/ phone numbers which is formatted as:
[TABLE="width: 500, align: left"]
<tbody>[TR]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Phone 1[/TD]
[TD]Phone 2[/TD]
[TD]All[/TD]
[TD]Choir[/TD]
[TD]Youth[/TD]
[TD]etc.[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Smith[/TD]
[TD]910-111-1111[/TD]
[TD]910-111-1112[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sara[/TD]
[TD]Green[/TD]
[TD]910-111-1113[/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]





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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Phone 1[/TD]
[TD]Phone 2[/TD]
[TD]Definition[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Smith[/TD]
[TD](910) 111-1111[/TD]
[TD] (910) 111-1112[/TD]
[TD] All[/TD]
[/TR]
[TR]
[TD]Sara[/TD]
[TD]Green[/TD]
[TD] (910) 111-1113[/TD]
[TD][/TD]
[TD] All[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Smith[/TD]
[TD] (910) 111-1111[/TD]
[TD](910) 111-1112[/TD]
[TD] Choir[/TD]
[/TR]
[TR]
[TD]Sara[/TD]
[TD] Green[/TD]
[TD] (910) 111-1113[/TD]
[TD][/TD]
[TD] Youth[/TD]
[/TR]
</tbody>[/TABLE]

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

 

[hiker95]

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
	A	B	C	D	E	F	G
1	First	Last	Phone 1	Phone 2	All	Choir	Youth
2	John	Smith	910-111-1111	910-111-1112	x	x
3	Sara	Green	910-111-1113		x		x
4
Sheet1

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

Excel 2007
	A
1	All
2	910-111-1111
3	910-111-1112
4	910-111-1113
5
6	Choir
7	910-111-1111
8	910-111-1112
9
10	Youth
11	910-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.

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.

 

[hiker95]

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).

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.

 

[cjackson10111]

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:
[TABLE="width: 1725"]
<tbody>[TR]
[TD="class: xl63, width: 220"][TABLE="width: 1649"]
<tbody>[TR]
[TD="class: xl65, width: 220"]First Name[/TD]
[TD="class: xl65, width: 87"]Last Name[/TD]
[TD="class: xl65, width: 88"]External ID[/TD]
[TD="class: xl68, width: 107"]Phone 1[/TD]
[TD="class: xl65, width: 52"]Ext 1[/TD]
[TD="class: xl65, width: 61"]Desc 1[/TD]
[TD="class: xl68, width: 102"]Phone 2[/TD]
[TD="class: xl65, width: 52"]Ext 2[/TD]
[TD="class: xl65, width: 61"]Desc 2[/TD]
[TD="class: xl67, width: 31"]1|All[/TD]
[TD="class: xl65, width: 92"] 2|Adult Choir [/TD]
[TD="class: xl65, width: 94"]3|Keen-Agers[/TD]
[TD="class: xl65, width: 59"]4|Youth[/TD]
[TD="class: xl65, width: 74"]5|Children[/TD]
[TD="class: xl65, width: 114"]6|Faithful Voices[/TD]
[TD="class: xl65, width: 115"]7|Susie's *******[/TD]
[TD="class: xl67, width: 112"]8|Admin Council[/TD]
[TD="class: xl65, width: 128"]9|Nursery Workers[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD="class: xl63, width: 87"][/TD]
[TD="class: xl63, width: 88"][/TD]
[TD="class: xl66, width: 107"][/TD]
[TD="class: xl63, width: 52"][/TD]
[TD="class: xl63, width: 61"][/TD]
[TD="class: xl66, width: 102"][/TD]
[TD="class: xl63, width: 52"][/TD]
[TD="class: xl63, width: 61"][/TD]
[TD="class: xl63, width: 106"][/TD]
[TD="class: xl63, width: 107"][/TD]
[TD="class: xl63, width: 141"][/TD]
[TD="class: xl63, width: 126"][/TD]
[TD="class: xl63, width: 59"][/TD]
[TD="class: xl63, width: 110"][/TD]
[TD="class: xl63, width: 73"][/TD]
[TD="class: xl65, width: 109"][/TD]
[TD="class: xl65, width: 64"][/TD]
[/TR]
</tbody>[/TABLE]

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

 

[hiker95]

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.