Macro to sort irregular data in report, help needed, conditional offset or transpose.

Kris vH

New Member
Apr 8, 2013
Hi everyone,

For the last week I have been trawling through many different posts and Excel resource websites trying to find a solution. Unfortunately I have to ask your help. I'm familiar with VBA and Macros, but not indepth or professional enough to knowing all the ins and outs of VBA, or its coding/language/terms.

I have a fortnightly payroll report from an antiquated system which puts the data in such a way I can't use it with my other HR information. I need to sort the data. Below you can see examples of what I have and what I want.

Attempt to Offset or Transpose
I tried looking at finding data and then offsetting it. However, due to the fact that not all have the same totals (for example some don't have the row "6 accrued day off") offsetting doesn't work. Unless I can build in multiple conditions, or offeset it against the name. Not sure how to do that.
If only the employee ID number wouldn't be in front of the names, then I could sort it by the numbers. But that doesn't work as some employees have the same number as ID (example "6 Croft Lara") However, luckily the name fields are unique as they have commas in them, so maybe some type of *,* condition may do the trick.
The first occurance of the name could be set as the start of the range, the second occurance of the same name as the end of the range. What is inbetween would then need to be sorted (offset/transposed) next to the first occurance of the name.

(Not in the example below) Next I would need to clean up the unused collumns, try to split the employee ID from the name and I would have an Excel sheet I can use.

How to create a Macro which can do all of the above? Your help/advise is much appreciated.


Before (what I have)
Page 1
Employee Leave Report for the Ranges Organisation Unit ID range 15 to 15 as at 31/03/2013
Organistaional UnitEmployeeOpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $
BalanceThis YearThis YearCreditsCreditsLiability
15 D Services
1143 Smith1, John1
3 sick leave with certificate0.690.000.000.690.000.6912.41
4 sick without certificate0.350.000.000.350.000.356.21
5 long service leave0.450.000.000.450.000.458.07
1143 Smith1, John11.490.000.001.490.001.4926.69
409 Smith2, John2
2 annual leave0.
5 long service leave183.130.000.00183.130.00183.134,594.45
409 Smith2, John2183.130.000.00183.130.00183.134,594.43
940 Smith3, John3
2 annual leave99.7757.06156.830.000.000.00-0.02
3 sick leave with certificate124.840.0095.0029.840.0029.84708.87
4 sick without certificate6.000.007.00-1.000.00-1.00-23.75
5 long service leave84.1312.360.0096.490.0096.492,291.81
15 leave loading60.8538.0498.880.
940 Smith3, John3375.58107.46357.71125.330.00125.332,976.91
560 Smith4, John4
2 annual leave104.08174.46211.0067.540.0067.541,786.62
3 sick leave with certificate271.5492.000.00363.540.00363.549,616.01
4 sick without certificate16.0022.007.0031.000.0031.00819.99
5 long service leave369.4037.800.00407.200.00407.2010,771.09
15 leave loading72.34116.31135.0053.650.0053.65248.36
560 Smith4, John4833.37442.57353.00922.940.00922.9423,242.07
1201 Croft1, Lara1
2 annual leave0.0070.210.0070.210.0070.211,468.58
3 sick leave with certificate0.0023.400.0023.400.0023.40489.53
4 sick without certificate0.0011.700.0011.700.0011.70244.76
5 long service leave0.0015.210.0015.210.0015.21318.19
7 time in lieu0.
15 leave loading0.0046.810.0046.810.0046.81171.33
1201 Croft1, Lara10.00175.347.00168.340.00168.342,713.31
6 Croft2, Lara2
2 annual leave0.
3 sick leave with certificate609.500.000.00609.500.00609.5011,971.80
4 sick without certificate16.000.000.0016.000.0016.00314.27
5 long service leave433.830.000.00433.830.00433.838,521.30
6 accrued day off0.
15 leave loading52.630.000.0052.630.0052.63180.90
6 Croft2, Lara21,111.950.000.001,111.950.001,111.9520,988.21


After (what I want)
Page 1
Employee Leave Report for the Ranges Organisation Unit ID range 15 to 15 as at 31/03/2013
2 annual leave3 sick leave with certificate4 sick without certificate5 long service leave6 accrued day off7 time in lieu15 leave loading
Organistaional UnitEmployeeOpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $
BalanceThis YearThis YearCreditsCreditsLiabilityBalanceThis YearThis YearCreditsCreditsLiabilityBalanceThis YearThis YearCreditsCreditsLiabilityBalanceThis YearThis YearCreditsCreditsLiabilityBalanceThis YearThis YearCreditsCreditsLiabilityBalanceThis YearThis YearCreditsCreditsLiabilityBalanceThis YearThis YearCreditsCreditsLiability
1143 Smith1, John10.690.000.000.690.000.6912.410.350.000.000.350.000.356.210.450.000.000.450.000.458.07
409 Smith2, John20.,594.45
940 Smith3, John399.7757.06156.830.000.000.00-0.02124.840.0095.0029.840.0029.84708.876.000.007.00-1.000.00-1.00-23.7584.1312.360.0096.490.0096.492,291.8160.8538.0498.880.
560 Smith4, John4104.08174.46211.0067.540.0067.541,786.62271.5492.000.00363.540.00363.549,616.0116.0022.007.0031.000.0031.00819.99369.4037.800.00407.200.00407.2010,771.0972.34116.31135.0053.650.0053.65248.36
1201 Croft1, Lara10.0070.210.0070.210.0070.211,468.580.0023.400.0023.400.0023.40489.530.0011.700.0011.700.0011.70244.760.0015.210.0015.210.0015.21318.
6 Croft2, Lara20.,971.8016.000.000.0016.000.0016.00314.27433.830.000.00433.830.00433.838,521.300.


Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
A nice one to work with arrays. I will be putting together a version where each type of leave (2 annual leave, or 5 long time service) has its own array, then it will be clearer and more easy to maintain then if everything was in one array.

Can you confirm that these are the only types of leave:
2 annual leave
3 sick leave with certificate
4 sick without certificate
5 long service leave
6 accrued day off
7 time in lieu
15 leave loading

Also when copying your tables to excel, I notice that there are a few empty columns: one (B:B) to the right of 'Organisational Unit' , two (D:E) to the right of 'Employee'. Is this also the case with your real data, or just in this example?
Upvote 0
Try this
Rich (BB code):
Option Explicit

Sub ReorganiseLeaveData()
    Dim ar2AnL, ar3SLwC, ar4SwoC, ar5LSL, ar6ADO, ar7TinL, ar15LL, arTitle
    Dim rEmp As Range, rOut As Range, i As Long
    Dim wsData As Worksheet, wsOutp As Worksheet

    Set wsData = ActiveSheet
    Set wsOutp = Worksheets.Add(after:=wsData)
    Set rOut = wsOutp.[A1]
    ' set titles on output page
    ReDim arTitle(1, 7)
    rOut.Offset(0, 5) = "2 Annual Leave"
    rOut.Offset(0, 12) = "3 Sick Leave with Certificate"
    rOut.Offset(0, 19) = "4 Sick without Certificate"
    rOut.Offset(0, 26) = "5 Long Leave Service"
    rOut.Offset(0, 33) = "6 Accrued Days Off"
    rOut.Offset(0, 40) = "7 Time in Lieu"
    rOut.Offset(0, 47) = "15 Leave Loading"
    rOut.Offset(1, 0) = "Organisational Unit"
    rOut.Offset(1, 2) = "Employee"
    arTitle(1, 1) = "Opening Balance"
    arTitle(1, 2) = "Accrued this Year"
    arTitle(1, 3) = "Taken This Year"
    arTitle(1, 4) = "Hrs Leave Credits"
    arTitle(1, 5) = "Adjustments"
    arTitle(1, 6) = "Total Leave Credits"
    arTitle(1, 7) = "Total $ Liability"
    For i = 0 To 6
        rOut.Offset(1, 5 + i * 7).Resize(1, 7) = arTitle
    Next i
    Set rOut = rOut.Offset(3, 0)
    Set rEmp = wsData.[A1]  ' assuming that the names etc are in column A:A
    ' Find top of list
    Do While rEmp.Value = vbNullString Or Not IsNumeric(Left(rEmp.Value, 1))
        Set rEmp = rEmp.Offset(1, 0)
    Do While rEmp.Value <> vbNullString
        i = 1
        With rEmp
            Do While .Offset(i, 0).Value <> .Value
                Select Case Trim(Left(.Offset(i, 0), 2))
                    Case 2
                        ar2AnL = .Offset(i, 5).Resize(1, 7)
                    Case 3
                        ar3SLwC = .Offset(i, 5).Resize(1, 7)
                    Case 4
                        ar4SwoC = .Offset(i, 5).Resize(1, 7)
                    Case 5
                        ar5LSL = .Offset(i, 5).Resize(1, 7)
                    Case 6
                        ar6ADO = .Offset(i, 5).Resize(1, 7)
                    Case 7
                        ar7TinL = .Offset(i, 5).Resize(1, 7)
                    Case 15
                        ar15LL = .Offset(i, 5).Resize(1, 7)
                    End Select
                i = i + 1
            'output employee's leave data on one row
            rOut.Value = .Value
            rOut.Offset(0, 2) = CleanName(.Value)
            rOut.Offset(0, 5).Resize(1, 7) = ar2AnL
            rOut.Offset(0, 12).Resize(1, 7) = ar3SLwC
            rOut.Offset(0, 19).Resize(1, 7) = ar4SwoC
            rOut.Offset(0, 26).Resize(1, 7) = ar5LSL
            rOut.Offset(0, 33).Resize(1, 7) = ar6ADO
            rOut.Offset(0, 40).Resize(1, 7) = ar7TinL
            rOut.Offset(0, 47).Resize(1, 7) = ar15LL
            Set rEmp = .Offset(i + 1, 0)
            Set rOut = rOut.Offset(1, 0)
        End With
    Set wsOutp = Nothing
    Set wsData = Nothing
    Set rOut = Nothing
    Set rEmp = Nothing
End Sub

Function CleanName(sInput As String) As String
    Dim i As Integer
    i = 1
    If sInput = vbNullString Then
        CleanName = vbNullString
        Do While IsNumeric(Mid(sInput, i, 1))
            i = i + 1
        CleanName = Trim(Right(sInput, Len(sInput) - i))
    End If
End Function
Upvote 0
(Goedemorgen en groetjes uit Australië / Good morning and greetings from Australia)

My table copied in post 1 is indeed real data, except I changed the names due to privacy considerations and I did not include all staff. So yes, the added empty columns are in original data. Easy to clean up afterwards. However, I did delete the organisation name from H1, and I ommited/forgot to include the totals and footer (because I don't need them in my result). So here below once more a correct example of my data. This did interupt the code. I will explain in next paragraph.

Wow! That's more complex than I thought. I start to vaguely see how you did that, I'm not that advanced yet. But I do learn from your code. Thanks. Due to the fact that it did start with the department name first "15 D Services" (stands for Disability Services and isn't a staff name) and at the totals ended with the department "15 D Services" the code got disrupted. However, by starting the Macro to delete these rows it works fine.

Beautiful job Sijpie. Much appreciated, it saves me huge amounts of work and I learned from it.

EXAMPLE DATA 2 (apologies)

Organisation Name
Page 1
Employee Leave Report for the Ranges Organisation Unit ID range 15 to 15 as at 31/03/2013
Organistaional Unit Employee OpeningAccruedTakenHrs LeaveAdjustmentTotal LeaveTotal $
BalanceThis YearThis YearCredits CreditsLiability
15 D Services
1143 Smith1, John1
3 sick leave with certificate 0.69000.6900.6912.41
4 sick without certificate 0.35000.3500.356.21
5 long service leave 0.45000.4500.458.07
1143 Smith1, John1 1.49001.4901.4926.69
409 Smith2, John2
2 annual leave 000000-0.02
5 long service leave 183.1300183.130183.134,594.45
409 Smith2, John2 183.1300183.130183.134,594.43
940 Smith3, John3
2 annual leave 99.7757.06156.83000-0.02
3 sick leave with certificate 124.8409529.84029.84708.87
4 sick without certificate 607-10-1-23.75
5 long service leave 84.1312.36096.49096.492,291.81
15 leave loading 60.8538.0498.880000
940 Smith3, John3 375.58107.46357.71125.330125.332,976.91
560 Smith4, John4
2 annual leave 104.08174.4621167.54067.541,786.62
3 sick leave with certificate 271.54920363.540363.549,616.01
4 sick without certificate 1622731031819.99
5 long service leave 369.437.80407.20407.2#####
15 leave loading 72.34116.3113553.65053.65248.36
560 Smith4, John4 833.37442.57353922.940922.94#####
1201 Croft1, Lara1
2 annual leave 070.21070.21070.211,468.58
3 sick leave with certificate 023.4023.4023.4489.53
4 sick without certificate 011.7011.7011.7244.76
5 long service leave 015.21015.21015.21318.19
7 time in lieu 08710120.92
15 leave loading 046.81046.81046.81171.33
1201 Croft1, Lara1 0175.347168.340168.342,713.31
6 Croft2, Lara2
2 annual leave 000000-0.08
3 sick leave with certificate 609.500609.50609.5#####
4 sick without certificate 160016016314.27
5 long service leave 433.8300433.830433.838,521.30
6 accrued day off 0000000.02
15 leave loading 52.630052.63052.63180.9
6 Croft2, Lara2
15 Disabilty Services59325.0317235.8620743.955816.99-294.59255522.41207477
***** End of Report *****
Printed 5/04/2013HR org name Human Resources Establishment V:9.32.00Printed By : PB

<colgroup><col span="12"></colgroup><tbody>
Upvote 0
OK Kris,

this should do the trick. The code now tests for the comma, as you suggested it was an indicator for a name field.

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> ReorganiseLeaveData()<br>    <SPAN style="color:#00007F">Dim</SPAN> ar2AnL, ar3SLwC, ar4SwoC, ar5LSL, ar6ADO, ar7TinL, ar15LL, arTitle<br>    <SPAN style="color:#00007F">Dim</SPAN> rEmp <SPAN style="color:#00007F">As</SPAN> Range, rOut <SPAN style="color:#00007F">As</SPAN> Range, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> wsData <SPAN style="color:#00007F">As</SPAN> Worksheet, wsOutp <SPAN style="color:#00007F">As</SPAN> Worksheet<br><br>    <SPAN style="color:#00007F">Set</SPAN> wsData = ActiveSheet<br>    <SPAN style="color:#00007F">Set</SPAN> wsOutp = Worksheets.Add(after:=wsData)<br>    <SPAN style="color:#00007F">Set</SPAN> rOut = wsOutp.[A1]<br>    <SPAN style="color:#007F00">' set titles on output page</SPAN><br>    <SPAN style="color:#00007F">ReDim</SPAN> arTitle(1, 7)<br>    rOut.Offset(0, 5) = "2 Annual Leave"<br>    rOut.Offset(0, 12) = "3 Sick Leave with Certificate"<br>    rOut.Offset(0, 19) = "4 Sick without Certificate"<br>    rOut.Offset(0, 26) = "5 Long Leave Service"<br>    rOut.Offset(0, 33) = "6 Accrued Days Off"<br>    rOut.Offset(0, 40) = "7 Time in Lieu"<br>    rOut.Offset(0, 47) = "15 Leave Loading"<br>    rOut.Offset(1, 0) = "Organisational Unit"<br>    rOut.Offset(1, 2) = "Employee"<br>    arTitle(1, 1) = "Opening Balance"<br>    arTitle(1, 2) = "Accrued this Year"<br>    arTitle(1, 3) = "Taken This Year"<br>    arTitle(1, 4) = "Hrs Leave Credits"<br>    arTitle(1, 5) = "Adjustments"<br>    arTitle(1, 6) = "Total Leave Credits"<br>    arTitle(1, 7) = "Total $ Liability"<br>    <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> 6<br>        rOut.Offset(1, 5 + i * 7).Resize(1, 7) = arTitle<br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    <SPAN style="color:#00007F">Set</SPAN> rOut = rOut.Offset(3, 0)<br>    wsData.Select<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> rEmp = wsData.[A1]  <SPAN style="color:#007F00">' assuming that the names etc are in column A:A</SPAN><br>    <br>    <SPAN style="color:#007F00">' Find top of list</SPAN><br>   <SPAN style="color:#007F00">' Do While rEmp.Value = vbNullString Or Not IsNumeric(Left(rEmp.Value, 1))</SPAN><br>    <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> InStr(1, rEmp.Value, ",", 1) = 0<br>        <SPAN style="color:#00007F">Set</SPAN> rEmp = rEmp.Offset(1, 0)<br>    <br>    <SPAN style="color:#00007F">Loop</SPAN><br>    <br>    <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> rEmp.Value <> vbNullString<br>        i = 1<br>        <br>        <SPAN style="color:#00007F">With</SPAN> rEmp<br>            <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> .Offset(i, 0).Value <> .Value And .Offset(i, 0).Value <> vbNullString<br>                <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Trim(Left(.Offset(i, 0), 2))<br>                    <SPAN style="color:#00007F">Case</SPAN> 2<br>                        ar2AnL = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">Case</SPAN> 3<br>                        ar3SLwC = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">Case</SPAN> 4<br>                        ar4SwoC = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">Case</SPAN> 5<br>                        ar5LSL = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">Case</SPAN> 6<br>                        ar6ADO = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">Case</SPAN> 7<br>                        ar7TinL = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">Case</SPAN> 15<br>                        ar15LL = .Offset(i, 5).Resize(1, 7)<br>                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>                    <br>                i = i + 1<br>            <SPAN style="color:#00007F">Loop</SPAN><br>            <SPAN style="color:#007F00">'check to see if we have valid employee</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> .Offset(i, 0).Value = .Value <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#007F00">'output employee's leave data on one row</SPAN><br>                rOut.Value = .Value<br>                rOut.Offset(0, 2) = CleanName(.Value)<br>                rOut.Offset(0, 5).Resize(1, 7) = ar2AnL<br>                rOut.Offset(0, 12).Resize(1, 7) = ar3SLwC<br>                rOut.Offset(0, 19).Resize(1, 7) = ar4SwoC<br>                rOut.Offset(0, 26).Resize(1, 7) = ar5LSL<br>                rOut.Offset(0, 33).Resize(1, 7) = ar6ADO<br>                rOut.Offset(0, 40).Resize(1, 7) = ar7TinL<br>                rOut.Offset(0, 47).Resize(1, 7) = ar15LL<br>                <SPAN style="color:#00007F">Set</SPAN> rEmp = .Offset(i + 1, 0)<br>                <SPAN style="color:#00007F">Set</SPAN> rOut = rOut.Offset(1, 0)<br>            <SPAN style="color:#00007F">Else</SPAN><br>                <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Do</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Loop</SPAN><br>    wsOutp.Select<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wsOutp = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsData = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rOut = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rEmp = <SPAN style="color:#00007F">Nothing</SPAN><br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><SPAN style="color:#00007F">Function</SPAN> CleanName(sInput <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>    <br>    i = 1<br>    <SPAN style="color:#00007F">If</SPAN> sInput = vbNullString <SPAN style="color:#00007F">Then</SPAN><br>        CleanName = vbNullString<br>    <SPAN style="color:#00007F">Else</SPAN><br>        <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> IsNumeric(Mid(sInput, i, 1))<br>            i = i + 1<br>        <SPAN style="color:#00007F">Loop</SPAN><br>        CleanName = Trim(Right(sInput, Len(sInput) - i))<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN></FONT>
Upvote 0

Forum statistics

Latest member

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