Convert time tracking Table into Database format

[Rohit88]

Hi there i have a sharepoint data source that people track their time worked. I have it in excel so its refreshable
the format is like this:

W/C	30/12/13	6/01/14	13/01/14	20/01/14	27/01/14
Andrew				8
Dan	0
David			6
Gavin	0	16
Hannah
Hayley	1			9
Jack	0
Jessie	3		4		2
Jo	0	28
Leisa	0.5	8			5
Lucy	0	20

<colgroup><col style="width:48pt" span="6" width="64"> </colgroup><tbody>
</tbody>

Now i would like to be able to get it to look as follows;

Name	Week Commencing	Hours Worked
Andrew	30/12/13	0
Andrew	6/01/14	0
Andrew	13/01/14	0
Andrew	20/01/14	8
etc

<tbody>
</tbody>

Is this even possible?

 

[MickG]

Results sheet2 starting "A1"

[COLOR="Navy"]Sub[/COLOR] MG15Jan38
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Lst         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))


ReDim Ray(1 To Rng.Count * Lst, 1 To 3)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] Ac = 2 To Lst
        c = c + 1
        Ray(c, 1) = Dn
        Ray(c, 2) = Cells(1, Ac)
        Ray(c, 3) = IIf(IsEmpty(Dn.Offset(, Ac - 1)), 0, Dn.Offset(, Ac - 1))
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
.Range("A1").Resize(, 3).Value = Array("Name", "Week Commencing", "Hours Worked")
.Range("A2").Resize(c, 3) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[hiker95]

Rohit88,

Is this even possible?

Yes. Each time you update the raw data, worksheet Results will either be created, or, cleared, and, the new results will be written to worksheet 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
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, 01/15/2014, ME750619
Dim a As Variant, o As Variant
Dim i As Long, ii As Long, c As Long, lr As Long, lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
a = Range(Cells(1, 1), Cells(lr, lc))
ReDim o(1 To ((UBound(a, 1) - 1) * (UBound(a, 2) - 1)), 1 To 3)
For i = 2 To UBound(a, 1)
  For c = 2 To UBound(a, 2)
    ii = ii + 1
    o(ii, 1) = a(i, 1)
    o(ii, 2) = a(1, c)
    If a(i, c) = "" Then: o(ii, 3) = 0: Else: o(ii, 3) = a(i, c)
  Next c
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
With Sheets("Results")
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(, 3).Value = Array("Name", "Week Commencing", "Hours Worked")
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Range("B2:B" & UBound(o, 2)).NumberFormat = "d/mm/yy"
  .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 ReorgData macro.

 

[hiker95]

Rohit88,

With your raw data in worksheet Sheet1

Is this even possible?

Yes. Each time you update the raw data, worksheet Results will either be created, or, cleared, and, the new results will be written to worksheet 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).

Option Explicit
Sub ReorgDataV2()
' hiker95, 01/15/2014, ME750619
Dim a As Variant, o As Variant
Dim i As Long, ii As Long, c As Long, lr As Long, lc As Long
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))
  ReDim o(1 To ((UBound(a, 1) - 1) * (UBound(a, 2) - 1)), 1 To 3)
End With
For i = 2 To UBound(a, 1)
  For c = 2 To UBound(a, 2)
    ii = ii + 1
    o(ii, 1) = a(i, 1)
    o(ii, 2) = a(1, c)
    If a(i, c) = "" Then: o(ii, 3) = 0: Else: o(ii, 3) = a(i, c)
  Next c
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=Sheets("Sheet1")).Name = "Results"
With Sheets("Results")
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(, 3).Value = Array("Name", "Week Commencing", "Hours Worked")
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Range("B2:B" & UBound(o, 2)).NumberFormat = "d/mm/yy"
  .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.

 

[Rohit88]

Awesome thanks alot!! Is there an additional bit of code that I can add to make it check a specific sheet instead of the one it is looking at? Also when i select to refresh data on my excel sheet can i get the macro to run to update the sheet is is set to update once the sharepoint list has been updated?

Sorry not done any VBA stuff before.

Cheers

Ro

 

[Rohit88]

Just one other thing aswell. For some reason the dates are coming through as US rather than UK only for 6/1/14 though the other dates are getting the stored as text flag

Cheers

 

[hiker95]

Rohit88,

When you respond to your helper, please use their site ID/username/handle.

This way, we know who should respond to your question(s).

 

[Rohit88]

Rohit88,

When you respond to your helper, please use their site ID/username/handle.

This way, we know who should respond to your question(s).

Ah apologies the questions were for your script hiker95

 

[hiker95]

Rohit88,

For some reason the dates are coming through as US rather than UK only for 6/1/14 though the other dates are getting the stored as text flag

I thought that the date format that you showed in your screenshot in reply #1, was the same format that my macro displayed?

Instead of using your flat text date format as per the above, can I see your actual workbook?

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.

 

[Rohit88]

Rohit88,



I thought that the date format that you showed in your screenshot in reply #1, was the same format that my macro displayed?

Instead of using your flat text date format as per the above, can I see your actual workbook?

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.

hiker95,

The date format is but for some reason when the code is run the 6/1/14 is changed to 6/1/14. Changing format to mm/dd/yy does convert the first instance of the date but the others remail 1/6/14

Ive uploaded the sharepoint data i receive. If its possible to have the date just as text that would be simple as ive had to have that in other parts of the database.

https://app.box.com/s/pi77xpkqb4tni7rozq9i