Restructuring Data

[davesfx]

I am needing some help restructuring some data.

I need to consolidate such as shown below. Results can be placed into another sheet. The zeros can be shown if need be and I can test and delete afterwards.

Thank you and Kindest Regards,

Davesfx

Excel Workbook
	A	B	C	D
1	DATES	Chicago,IL	Los Angeles,CA	Las Vegas,NV
2	10-Aug	0	0	0
3	11-Aug	1	5	0
4	12-Aug	2	0	1
5	13-Aug	0	0	1
Sheet1

Excel Workbook
	A	B	C
11	DATES	District	Count
12	11-Aug	Chicago,IL	1
13	11-Aug	Los Angeles,CA	5
14	12-Aug	Chicago,IL	2
15	12-Aug	Las Vegas,NV	1
16	13-Aug	Las Vegas,NV	1
Sheet1

 

[iliace]

You can use the approach described here:

http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

 

[davesfx]

I had visited the page before but wasn't interested in setting up a pivot table. Had I taken the time to read the whole page, I would have seen the VBA option at the bottom.

thank you very much for your time! Greatly appreciated.

Now..back to coding!

 

[iliace]

OK, but note that the Pivot Table is a temporary arrangement... once you have the end result, it's actually a data sheet and you can delete the Pivot Table if you wish.

 

[hiker95]

davesfx,


Thank you for the Private Message.


The macro will adjust for additional columns with titles in row 1 of worksheet Sheet1.


Sample raw data in worksheet Sheet1:

Excel Workbook
	A	B	C	D
1	DATES	Chicago,IL	Los Angeles,CA	Las Vegas,NV
2	10-Aug	0	0	0
3	11-Aug	1	5	0
4	12-Aug	2	0	1
5	13-Aug	0	0	1
6
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B	C
1	DATES	District	Count
2	11-Aug	Chicago,IL	1
3	11-Aug	Los Angeles,CA	5
4	12-Aug	Chicago,IL	2
5	12-Aug	Las Vegas,NV	1
6	13-Aug	Las Vegas,NV	1
7
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, 08/10/2011
' http://www.mrexcel.com/forum/showthread.php?t=570795
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, a As Long, aa As Long, NR As Long, LC 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:C1") = [{"DATES","District","Count"}]
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
LC = w1.Cells(1, Columns.Count).End(xlToLeft).Column
For a = 2 To LR Step 1
  For aa = 2 To LC Step 1
    If w1.Cells(a, aa) > 0 Then
      NR = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wR.Range("A" & NR) = w1.Cells(a, 1)
      wR.Range("B" & NR) = w1.Cells(1, aa)
      wR.Range("C" & NR) = w1.Cells(a, aa)
    End If
  Next aa
Next a
wR.Range("A2:A" & NR).NumberFormat = "d-mmm"
wR.UsedRange.Columns.AutoFit
wR.Activate
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.

 

[davesfx]

Thank you very much.

I have been spinning my wheels for a couple of days. Both are lifesavers.

My day has gotten much better

 

[hiker95]

davesfx,

You are very welcome.

Glad I could help.

Thanks for the feedback.

Come back anytime.