Re-arranging data to create sortable database

[condoman]

Hi.

I am creating a contact database. I started with a Google form for families in our organization to fill out which asked them to provide a household name ("HH"), addresses info, then first names of family members, birth dates, and emails (in that order):

HH Address Name1 BDay1 Email1 Name2 Bday2 Email2 Name 3.....

The data is neatly presented in a google spreadsheet and lists the requested family info across in one long row. One row per family. I then exported the raw data into Excel 2003.

As you can probably figure I really need an individual row for each person in order to have an effective, sortable database. One where each row leads with the proper HH and Address
for each Name, Bday, and Email.

Is there a formulaic way to get the data arranged properly?

Thanks.

 

[ziad alsayed]

welcome on board Condoman

please can you paste part of your data and also sample on how you want it to be.

 

[jbeaucaire]

'ROWS TO COLUMNS
Here's a macro for expanding rows of data to multiple rows parsing out the values in the row in "groups" while duplicating the first few columns you indicate. There's a sample workbook too you could drop your data into and test it out.

Rows to Columns - Part 1B​

The sample workbook is actually setup like your example above, so it's easy to see it in action.

 

[hiker95]

condoman,

What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

 

[condoman]

Using Excel 2003.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Household Name	Address 1	City	State	First Name 1	Email 1	Birthday 1	First Name 2	Email 2	Birthday 2	First Name 3	Email 3	Birthday 3
2	Smith	123 Elm St	Wichita	KZ	Steve	steve@yahoo.com	1/1/1970	myra	myra@yahoo.com	5/2/1970	Billy		6/1/2007
3	Jones	456 Main Ave	Seattle	WA	Cynthia	cytnhia@hotmail.com	8/2/1975
4	Johnson	789 Pine Drive	Miami	FL	Michael	mike@gmail.com	10/1/1946	Elanor	ej@gmail.com	8/4/1950	mark	mark@gmail.com	4/4/1990
Sheet1

Excel 2003

 

[condoman]

And would like it to look like this:

Excel Workbook
	A	B	C	D	E	F	G
6	Smith	123 Elm St	Wichita	KZ	Steve	steve@yahoo.com	1/1/1970
7	Smith	123 Elm St	Wichita	KZ	myra	myra@yahoo.com	5/2/1970
8	Smith	123 Elm St	Wichita	KZ	Billy		6/1/2007
9	Jones	456 Main Ave	Seattle	WA	Cynthia	cytnhia@hotmail.com	8/2/1975
10	Johnson	789 Pine Drive	Miami	FL	Michael	mike@gmail.com	10/1/1946
11	Johnson	789 Pine Drive	Miami	FL	Elanor	ej@gmail.com	8/4/1950
12	Johnson	789 Pine Drive	Miami	FL	mark	mark@gmail.com	4/4/1990
Sheet1

Excel 2003

 

[jbeaucaire]

I just checked that data against the macro link I gave above, it works. Just answer 5 to the first popup and 3 to the second, it should split the data down nicely.

I just tweaked a couple lines in the end of that macro Part 1b, so ...

Sub ReOrganize2()
'JBeaucaire  (11/4/2009)        edited 6/15/2010
'Turns row data into columnar data, groups of data merged down together
Dim Rw As Long, CurRw As Long, FirstCol As Long
Dim Col As Long, LastCol As Long, ColNums As Long

Application.ScreenUpdating = False

'column where first group begins, all rows to left will be duped
FirstCol = Application.InputBox _
    ("First column number where group data starts?" & vbLf & _
    "(B=2, C=3, etc)" & vbLf & vbLf & _
    "All columns to the left will be duplicated", _
    "First Group column", 5, Type:=1)
If FirstCol = 0 Then Exit Sub

'how many columns to treat as a group, starting in column FirstCol
ColNums = Application.InputBox _
    ("How many columns in each group to split down?", _
        "Columns in each Group", 3, Type:=1)
If ColNums = 0 Then Exit Sub

Rw = 2          'starting row
    Do Until Range("A" & Rw) = ""
        LastCol = Cells(Rw, Columns.Count).End(xlToLeft).Column
        CurRw = Rw
        For Col = (FirstCol + ColNums) To LastCol Step ColNums
            If Cells(CurRw, Col) <> "" Then
                Rw = Rw + 1
                Rows(Rw).Insert xlShiftDown
                Cells(Rw - 1, "A").Resize(, FirstCol - 1).Copy Cells(Rw, "A").Resize(, FirstCol - 1)
                Cells(Rw, FirstCol).Resize(1, ColNums).Value = Cells(CurRw, Col).Resize(1, ColNums).Value
            End If
        Next Col
        Rw = Rw + 1
    Loop

'Cleanup appearance
    Range(Cells(1, FirstCol + ColNums), Cells(Rows.Count, Col + ColNums)).ClearContents
    Cells.Columns.AutoFit
    
Application.ScreenUpdating = True
End Sub

Rows to Columns - Part 1B​

 

[hiker95]

condoman,


The macro will adjust for a varying number of First Names.


Sample raw data on worksheet Sheet1:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Household Name	Address 1	City	State	First Name 1	Email 1	Birthday 1	First Name 2	Email 2	Birthday 2	First Name 3	Email 3	Birthday 3
2	Smith	123 Elm St	Wichita	KZ	Steve	steve@yahoo.com	1/1/1970	myra	myra@yahoo.com	5/2/1970	Billy		6/1/2007
3	Jones	456 Main Ave	Seattle	WA	Cynthia	cytnhia@hotmail.com	8/2/1975
4	Johnson	789 Pine Drive	Miami	FL	Michael	mike@gmail.com	10/1/1946	Elanor	ej@gmail.com	8/4/1950	mark	mark@gmail.com	4/4/1990
5
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B	C	D	E	F	G
1	Household Name	Address	City	State	First Name	Email	Birthday
2	Smith	123 Elm St	Wichita	KZ	Steve	steve@yahoo.com	1/1/1970
3	Smith	123 Elm St	Wichita	KZ	myra	myra@yahoo.com	5/2/1970
4	Smith	123 Elm St	Wichita	KZ	Billy		6/1/2007
5	Jones	456 Main Ave	Seattle	WA	Cynthia	cytnhia@hotmail.com	8/2/1975
6	Johnson	789 Pine Drive	Miami	FL	Michael	mike@gmail.com	10/1/1946
7	Johnson	789 Pine Drive	Miami	FL	Elanor	ej@gmail.com	8/4/1950
8	Johnson	789 Pine Drive	Miami	FL	mark	mark@gmail.com	4/4/1990
9
Results

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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 09/02/2011
' http://www.mrexcel.com/forum/showthread.php?t=576348
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, LC As Long, a As Long, c As Long, NR As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
wR.Range("A1:G1") = [{"Household Name","Address","City","State","First Name","Email","Birthday"}]
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To LR Step 1
  NR = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
  wR.Range("A" & NR).Resize(, 7).Value = w1.Range("A" & a).Resize(, 7).Value
  LC = w1.Cells(a, Columns.Count).End(xlToLeft).Column
  For c = 8 To LC Step 3
    If w1.Cells(a, c) <> "" Then
      NR = NR + 1
      wR.Range("A" & NR).Resize(, 4).Value = w1.Range("A" & a).Resize(, 4).Value
      wR.Range("E" & NR).Resize(, 3).Value = w1.Cells(a, c).Resize(, 3).Value
    End If
  Next c
Next a
wR.UsedRange.Columns.AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[condoman]

Very nice. Macro works great and is a perfect solution.
Hiker95-Thank you.

 

[hiker95]

condoman,

Thanks for the feedback.

Glad I could help.

You are very welcome.

Come back anytime.