Help converting cross table to list

rbis84

New Member
Joined
Mar 7, 2013
Messages
25
Hi All,

Would anyone be able to offer some advice on how to convert a cross table to a list in Excel 2010 as per the following example please? Basically i have a number of resource tracking worksheets (one per site) and the staff fill in their days per site as planned and worked. I was able to convert this into a list with VBA, but now need to include a code for the type of work. Adding the code to the list has me stumped.

I have this:

DATEAdam plannedAdam workedAdam CodeBeth plannedBeth workedBeth Code
01/01/20130.01.0A0.01.0C
02/01/20130.51.0B0.51.0B
And want this:
DateNameTypeValueCode
01/01/2013AdamPlanned0A
01/01/2013AdamWorked1A
01/01/2013BethPlanned0C
01/01/2013BethWorked1C

<tbody>
</tbody>

Any help gratefully received!!

Thanks
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
rbis84,

With your raw data in worksheet Sheet1 (each name is displayed per the next screenshot):


Excel 2007
ABCDEFG
1DATEAdam plannedAdam workedAdam CodeBeth plannedBeth workedBeth Code
21/1/201301A01C
32/1/20130.51B0.51B
4
Sheet1


After the macro in a new worksheet Results:


Excel 2007
ABCDE
1DateNameTypeValueCode
21/1/2013AdamPlanned0A
31/1/2013AdamWorked1A
41/1/2013BethPlanned0C
51/1/2013BethWorked1C
62/1/2013AdamPlanned0.5B
72/1/2013AdamWorked1B
82/1/2013BethPlanned0.5B
92/1/2013BethWorked1B
10
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 and Function, 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.

Code:
Option Explicit
Sub ReorgData()
' hiker95, 03/21/2013
' http://www.mrexcel.com/forum/excel-questions/692865-help-converting-cross-table-list.html
Dim a As Variant, b As Variant, s
Dim i As Long, ii As Long, c As Long
With Sheets("Sheet1")
  a = .Cells(1).CurrentRegion
  ReDim b(1 To ((UBound(a, 2) - 1) / 3) * ((UBound(a, 1) - 1) * 2) + 1, 1 To 5)
End With
ii = 1
b(ii, 1) = "Date": b(ii, 2) = "Name": b(ii, 3) = "Type": b(ii, 4) = "Value": b(ii, 5) = "Code"
For i = 2 To UBound(a, 1)
  For c = 2 To UBound(a, 2) Step 3
    s = Split(a(1, c), " ")
    ii = ii + 1
    b(ii, 1) = a(i, 1)
    b(ii, 2) = s(0)
    b(ii, 3) = "Planned"
    b(ii, 4) = a(i, c)
    b(ii, 5) = a(i, c + 2)
    ii = ii + 1
    b(ii, 1) = a(i, 1)
    b(ii, 2) = s(0)
    b(ii, 3) = "Worked"
    b(ii, 4) = a(i, c + 1)
    b(ii, 5) = a(i, c + 2)
  Next c
Next i
If Not WorksheetExists("Results") Then
  Worksheets.Add(After:=Sheets("Sheet1")).Name = "Results"
End If
With Sheets("Results")
  .UsedRange.ClearContents
  .Cells(1).Resize(UBound(b, 1), UBound(b, 2)) = b
  .Columns.AutoFit
  .Activate
End With
End Sub

Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

Before you use the macro and Function 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
Hi Hiker95,

Many thanks for this, I will try it tonight.

Can I ask - is it possible to write this code so that it works for sheets with a different number of people? For example, worksheet 1 may contain Adam & Beth, worksheet 2 may contains Adam, Beth & Charlie.

The reason for asking is that I may need to collate information from numerous worksheets which follow the same structure but with a different number of people in each.

Thanks again.

R
 
Upvote 0
rbis84,

You are very welcome. Glad I could help.

is it possible to write this code so that it works for sheets with a different number of people?

It should work, as long as the dates are in column A, and each person's information contains three columns, and there are no gaps in the data going from left to right.

If it does not work, then I will have to see the new data structure.
 
Upvote 0
Hi Hiker95,

Thank you very much, this works like a dream! Really appreciate your help.

I presume I could make this loop through a number of worksheets using something like a worksheet count and loop function? I'll give it a try!

Thanks again.

R
 
Upvote 0
rbis84,

You are very welcome. Glad I could help.

Thanks for the feedback.

I presume I could make this loop through a number of worksheets using something like a worksheet count and loop function? I'll give it a try!

I could re-write the macro to do this for you, but, I will have to see the workbook with at least three additional worksheets.

I assume that worksheet Results will contain all the information from all the other worksheets?

So that I can get it right the first time:

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

I'm still at the development stage of what I'm doing, so don't have a file with any real data in it yet! The structure i'm planning on using would be exactly as you've described already, multiple tabs with the same structure in each and a results tab that collates the information from all three.

Will upload a file if you think it would be helpful.

Thanks again for the help.

R
 
Upvote 0
rbis84,

To continue I will need to see a workbook containing at least two worksheets containing your different raw data.

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


If you can not supply the above, then:

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0
rbis84,

Thanks for the workbook.

I may have to make an adjustment in the new macro based on the way the person's actual name is displayed in the raw data, like this Person 1 Planned.

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, 03/24/2013
' http://www.mrexcel.com/forum/excel-questions/692865-help-converting-cross-table-list.html
Dim wR As Worksheet, ws As Worksheet
Dim a As Variant, b As Variant, s, h As String, iii As Long
Dim i As Long, ii As Long, c As Long, nr As Long, lr As Long
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
wR.Cells(1, 1).Resize(, 5).Value = [{"Date","Name","Type","Value","Code"}]
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Results" Then
    With ws
      a = .Cells(1).CurrentRegion
      ReDim b(1 To ((UBound(a, 2) - 1) / 3) * ((UBound(a, 1) - 1) * 2), 1 To 5)
    End With
    ii = 0
    For i = 2 To UBound(a, 1)
      For c = 2 To UBound(a, 2) Step 3
        If a(i, c) <> "" Then
          s = Split(a(1, c), " ")
          ii = ii + 1
          b(ii, 1) = a(i, 1)
          If UBound(s) = 1 Then
            b(ii, 2) = s(0)
          Else
            h = ""
            For iii = LBound(s) To UBound(s) - 1
              h = h & s(iii) & " "
            Next iii
            If Right(h, 1) = " " Then
              h = Left(h, Len(h) - 1)
              b(ii, 2) = h
            End If
          End If
          b(ii, 3) = "Planned"
          b(ii, 4) = a(i, c)
          b(ii, 5) = a(i, c + 2)
          ii = ii + 1
          b(ii, 1) = a(i, 1)
          If UBound(s) = 1 Then
            b(ii, 2) = s(0)
          Else
            h = ""
            For iii = LBound(s) To UBound(s) - 1
              h = h & s(iii) & " "
            Next iii
            If Right(h, 1) = " " Then
              h = Left(h, Len(h) - 1)
              b(ii, 2) = h
            End If
          End If
          b(ii, 3) = "Worked"
          b(ii, 4) = a(i, c + 1)
          b(ii, 5) = a(i, c + 2)
        End If
      Next c
    Next i
    nr = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    wR.Cells(nr, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
    Erase a
    Erase b
  End If
Next ws
With Sheets("Results")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Cells(2, 1).Resize(lr).NumberFormat = "dd/mm/yyyy;@"
  .Cells(2, 4).Resize(lr).NumberFormat = "0.0"
  .Columns.AutoFit
  .Activate
End With
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

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

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