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

[Kris vH]

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.

Kris



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 Unit		Employee			Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $
					Balance	This Year	This Year	Credits		Credits	Liability
15 D Services
1143 Smith1, John1
3 sick leave with certificate					0.69	0.00	0.00	0.69	0.00	0.69	12.41
4 sick without certificate					0.35	0.00	0.00	0.35	0.00	0.35	6.21
5 long service leave					0.45	0.00	0.00	0.45	0.00	0.45	8.07
1143 Smith1, John1					1.49	0.00	0.00	1.49	0.00	1.49	26.69
409 Smith2, John2
2 annual leave					0.00	0.00	0.00	0.00	0.00	0.00	-0.02
5 long service leave					183.13	0.00	0.00	183.13	0.00	183.13	4,594.45
409 Smith2, John2					183.13	0.00	0.00	183.13	0.00	183.13	4,594.43
940 Smith3, John3
2 annual leave					99.77	57.06	156.83	0.00	0.00	0.00	-0.02
3 sick leave with certificate					124.84	0.00	95.00	29.84	0.00	29.84	708.87
4 sick without certificate					6.00	0.00	7.00	-1.00	0.00	-1.00	-23.75
5 long service leave					84.13	12.36	0.00	96.49	0.00	96.49	2,291.81
15 leave loading					60.85	38.04	98.88	0.00	0.00	0.00	0.00
940 Smith3, John3					375.58	107.46	357.71	125.33	0.00	125.33	2,976.91
560 Smith4, John4
2 annual leave					104.08	174.46	211.00	67.54	0.00	67.54	1,786.62
3 sick leave with certificate					271.54	92.00	0.00	363.54	0.00	363.54	9,616.01
4 sick without certificate					16.00	22.00	7.00	31.00	0.00	31.00	819.99
5 long service leave					369.40	37.80	0.00	407.20	0.00	407.20	10,771.09
15 leave loading					72.34	116.31	135.00	53.65	0.00	53.65	248.36
560 Smith4, John4					833.37	442.57	353.00	922.94	0.00	922.94	23,242.07
1201 Croft1, Lara1
2 annual leave					0.00	70.21	0.00	70.21	0.00	70.21	1,468.58
3 sick leave with certificate					0.00	23.40	0.00	23.40	0.00	23.40	489.53
4 sick without certificate					0.00	11.70	0.00	11.70	0.00	11.70	244.76
5 long service leave					0.00	15.21	0.00	15.21	0.00	15.21	318.19
7 time in lieu					0.00	8.00	7.00	1.00	0.00	1.00	20.92
15 leave loading					0.00	46.81	0.00	46.81	0.00	46.81	171.33
1201 Croft1, Lara1					0.00	175.34	7.00	168.34	0.00	168.34	2,713.31
6 Croft2, Lara2
2 annual leave					0.00	0.00	0.00	0.00	0.00	0.00	-0.08
3 sick leave with certificate					609.50	0.00	0.00	609.50	0.00	609.50	11,971.80
4 sick without certificate					16.00	0.00	0.00	16.00	0.00	16.00	314.27
5 long service leave					433.83	0.00	0.00	433.83	0.00	433.83	8,521.30
6 accrued day off					0.00	0.00	0.00	0.00	0.00	0.00	0.02
15 leave loading					52.63	0.00	0.00	52.63	0.00	52.63	180.90
6 Croft2, Lara2					1,111.95	0.00	0.00	1,111.95	0.00	1,111.95	20,988.21

<tbody>
</tbody>

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 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
Organistaional Unit		Employee			Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $	Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $	Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $	Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $	Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $	Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $	Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $
					Balance	This Year	This Year	Credits		Credits	Liability	Balance	This Year	This Year	Credits		Credits	Liability	Balance	This Year	This Year	Credits		Credits	Liability	Balance	This Year	This Year	Credits		Credits	Liability	Balance	This Year	This Year	Credits		Credits	Liability	Balance	This Year	This Year	Credits		Credits	Liability	Balance	This Year	This Year	Credits		Credits	Liability
1143 Smith1, John1												0.69	0.00	0.00	0.69	0.00	0.69	12.41	0.35	0.00	0.00	0.35	0.00	0.35	6.21	0.45	0.00	0.00	0.45	0.00	0.45	8.07
409 Smith2, John2					0.00	0.00	0.00	0.00	0.00	0.00	-0.02															183.13	0.00	0.00	183.13	0.00	183.13	4,594.45
940 Smith3, John3					99.77	57.06	156.83	0.00	0.00	0.00	-0.02	124.84	0.00	95.00	29.84	0.00	29.84	708.87	6.00	0.00	7.00	-1.00	0.00	-1.00	-23.75	84.13	12.36	0.00	96.49	0.00	96.49	2,291.81															60.85	38.04	98.88	0.00	0.00	0.00	0.00
560 Smith4, John4					104.08	174.46	211.00	67.54	0.00	67.54	1,786.62	271.54	92.00	0.00	363.54	0.00	363.54	9,616.01	16.00	22.00	7.00	31.00	0.00	31.00	819.99	369.40	37.80	0.00	407.20	0.00	407.20	10,771.09															72.34	116.31	135.00	53.65	0.00	53.65	248.36
1201 Croft1, Lara1					0.00	70.21	0.00	70.21	0.00	70.21	1,468.58	0.00	23.40	0.00	23.40	0.00	23.40	489.53	0.00	11.70	0.00	11.70	0.00	11.70	244.76	0.00	15.21	0.00	15.21	0.00	15.21	318.19								0.00	8.00	7.00	1.00	0.00	1.00	20.92	0.00	46.81	0.00	46.81	0.00	46.81	171.33
6 Croft2, Lara2					0.00	0.00	0.00	0.00	0.00	0.00	-0.08	609.50	0.00	0.00	609.50	0.00	609.50	11,971.80	16.00	0.00	0.00	16.00	0.00	16.00	314.27	433.83	0.00	0.00	433.83	0.00	433.83	8,521.30	0.00	0.00	0.00	0.00	0.00	0.00	0.02								52.63	0.00	0.00	52.63	0.00	52.63	180.90

<tbody>
</tbody>

 

[sijpie]

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?

 

[sijpie]

Try this

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)
    wsData.Select
    
    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)
    
    Loop
    
    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
            Loop
            '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
    Loop
    wsOutp.Select
    
    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
    Else
        Do While IsNumeric(Mid(sInput, i, 1))
            i = i + 1
        Loop
        CleanName = Trim(Right(sInput, Len(sInput) - i))
    End If
End Function

 

[Kris vH]

(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			Opening	Accrued	Taken	Hrs Leave	Adjustment	Total Leave	Total $
					Balance	This Year	This Year	Credits		Credits	Liability
15 D Services
1143 Smith1, John1
3 sick leave with certificate					0.69	0	0	0.69	0	0.69	12.41
4 sick without certificate					0.35	0	0	0.35	0	0.35	6.21
5 long service leave					0.45	0	0	0.45	0	0.45	8.07
1143 Smith1, John1					1.49	0	0	1.49	0	1.49	26.69
409 Smith2, John2
2 annual leave					0	0	0	0	0	0	-0.02
5 long service leave					183.13	0	0	183.13	0	183.13	4,594.45
409 Smith2, John2					183.13	0	0	183.13	0	183.13	4,594.43
940 Smith3, John3
2 annual leave					99.77	57.06	156.83	0	0	0	-0.02
3 sick leave with certificate					124.84	0	95	29.84	0	29.84	708.87
4 sick without certificate					6	0	7	-1	0	-1	-23.75
5 long service leave					84.13	12.36	0	96.49	0	96.49	2,291.81
15 leave loading					60.85	38.04	98.88	0	0	0	0
940 Smith3, John3					375.58	107.46	357.71	125.33	0	125.33	2,976.91
560 Smith4, John4
2 annual leave					104.08	174.46	211	67.54	0	67.54	1,786.62
3 sick leave with certificate					271.54	92	0	363.54	0	363.54	9,616.01
4 sick without certificate					16	22	7	31	0	31	819.99
5 long service leave					369.4	37.8	0	407.2	0	407.2	#####
15 leave loading					72.34	116.31	135	53.65	0	53.65	248.36
560 Smith4, John4					833.37	442.57	353	922.94	0	922.94	#####
1201 Croft1, Lara1
2 annual leave					0	70.21	0	70.21	0	70.21	1,468.58
3 sick leave with certificate					0	23.4	0	23.4	0	23.4	489.53
4 sick without certificate					0	11.7	0	11.7	0	11.7	244.76
5 long service leave					0	15.21	0	15.21	0	15.21	318.19
7 time in lieu					0	8	7	1	0	1	20.92
15 leave loading					0	46.81	0	46.81	0	46.81	171.33
1201 Croft1, Lara1					0	175.34	7	168.34	0	168.34	2,713.31
6 Croft2, Lara2
2 annual leave					0	0	0	0	0	0	-0.08
3 sick leave with certificate					609.5	0	0	609.5	0	609.5	#####
4 sick without certificate					16	0	0	16	0	16	314.27
5 long service leave					433.83	0	0	433.83	0	433.83	8,521.30
6 accrued day off					0	0	0	0	0	0	0.02
15 leave loading					52.63	0	0	52.63	0	52.63	180.9
6 Croft2, Lara2
15 Disabilty Services			59325.03	17235.86	20743.9	55816.99	-294.592	55522.4	1207477
		Totals		59325.03		20743.9		-294.592		1207477
					17235.86		55816.99		55522.4
							***** End of Report *****
Printed 5/04/2013						HR org name Human Resources Establishment V:9.32.00	Printed By : PB

<colgroup><col span="12"></colgroup><tbody>
</tbody>

 

[sijpie]

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>