-
Mar 11th, 2014, 08:07 AM
#1
Thread Starter
Lively Member
[RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Hi All,
Thanks to the help of two forum members TntinMN and vbfbryce for getting me to this point, it has saved me weeks of work in the future!
So i thought I would post the next part of my work that is done manually so see if this is a possibility.
I have the attached data
What I want to do is copy data to a new sheet, each person on this NEW sheet will only have ONE row for each period.
Rules:
- If the employee has only ONE record for a period ("Pay Date from - Pay Date to") then
-move data from ORIGINAL DATA columns A to E to the NEW SHEET columns A to E
-If the employee has multiple records for a period (""Pay Date from - Pay Date to") then...
-On the NEW SHEET the "Full time ANNUAL salary" (Col B) will be:-
A total of "ANNUAL part-time salary" (col G) for the multiple records DIVIDED by the total % of "Percentage Worked"
e.g Rows 3 and 4 of sample data - £2,975.54/24% = £12,398.13 <<-- This will be the "Full time ANNUAL salary" on the NEW SHEET -Monthly earnings will always be £1
-Column F on the NEW SHEET will a total of "Days Excluded" (col H)
The only rows on the NEW SHEET that will have data in column F will be those that had multiple rows on the original data.
Hope I have explained this well enough.
Thanks in advance.
Test Data (concat).zip
-
Mar 11th, 2014, 09:34 AM
#2
Re: If employee has multiple rows for same period - VBA (EXCEL)
I added a sheet and named it "NEW" and then used this code:
Code:
Sub copyToNew()
Dim wb As Workbook
Dim wsTest As Worksheet
Dim wsNew As Worksheet
Dim lr As Long
Dim wr As Long
Dim j As Long
Dim k As Long
Dim m As Integer
Dim n As Integer
Dim rngSort As Range
Dim rngKey1 As Range
Dim rngKey2 As Range
Dim emps() As String
Dim counter As Long
Dim empStart As Long
Dim empEnd As Long
Dim writeRow As Long
Dim sumSal As Long
Dim sumPer As Double
Dim ftaNew As Double
Set wb = ActiveWorkbook
Set wsTest = wb.Worksheets("TESTING")
Set wsNew = wb.Worksheets("NEW")
lr = wsTest.Range("a" & Rows.Count).End(xlUp).Row
For j = 2 To lr
If wsTest.Range("a" & j).Value <> wsTest.Range("a" & j - 1).Value Then
ReDim Preserve emps(counter)
emps(counter) = wsTest.Range("a" & j).Value
counter = counter + 1
End If
Next j
Set rngSort = wsTest.Range("a1:h" & lr)
Set rngKey1 = wsTest.Range("a2:a" & lr)
Set rngKey2 = wsTest.Range("d2:d" & lr)
With wsTest.Sort
.SortFields.Clear
.SortFields.Add Key:=rngKey1
.SortFields.Add Key:=rngKey2
.SetRange rngSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
empStart = 2
With wsTest
For j = 0 To UBound(emps)
For k = empStart + 1 To lr
If .Range("d" & k).Value <> .Range("d" & k - 1).Value Then
empEnd = k - 1
writeRow = wsNew.Range("a" & Rows.Count).End(xlUp).Row + 1
If empStart = empEnd Then
For m = 1 To 5
wsNew.Cells(writeRow, m).Value = wsTest.Cells(k - 1, m).Value
Next m
Else
sumSal = 0
sumPer = 0
For n = empStart To empEnd
sumSal = sumSal + .Range("g" & n).Value
sumPer = sumPer + .Range("f" & n).Value
Next n
ftaNew = sumSal / sumPer
wsNew.Range("a" & writeRow).Value = wsTest.Range("a" & empStart).Value
wsNew.Range("b" & writeRow).Value = ftaNew
wsNew.Range("c" & writeRow).Value = 1
wsNew.Range("d" & writeRow).Value = wsTest.Range("d" & empStart).Value
wsNew.Range("e" & writeRow).Value = wsTest.Range("e" & empEnd).Value
wsNew.Range("f" & writeRow).Value = wsTest.Range("h" & empStart).Value
End If
empStart = empEnd + 1
Else
'else move on
End If
Next k
Next j
End With
End Sub
-
Mar 11th, 2014, 09:36 AM
#3
Re: If employee has multiple rows for same period - VBA (EXCEL)
One more try:
Code:
Sub copyToNew()
Dim wb As Workbook
Dim wsTest As Worksheet
Dim wsNew As Worksheet
Dim lr As Long
Dim wr As Long
Dim j As Long
Dim k As Long
Dim m As Integer
Dim n As Integer
Dim rngSort As Range
Dim rngKey1 As Range
Dim rngKey2 As Range
Dim emps() As String
Dim counter As Long
Dim empStart As Long
Dim empEnd As Long
Dim writeRow As Long
Dim sumSal As Long
Dim sumPer As Double
Dim ftaNew As Double
Set wb = ActiveWorkbook
Set wsTest = wb.Worksheets("TESTING")
Set wsNew = wb.Worksheets("NEW")
lr = wsTest.Range("a" & Rows.Count).End(xlUp).Row
For j = 2 To lr
If wsTest.Range("a" & j).Value <> wsTest.Range("a" & j - 1).Value Then
ReDim Preserve emps(counter)
emps(counter) = wsTest.Range("a" & j).Value
counter = counter + 1
End If
Next j
Set rngSort = wsTest.Range("a1:h" & lr)
Set rngKey1 = wsTest.Range("a2:a" & lr)
Set rngKey2 = wsTest.Range("d2:d" & lr)
With wsTest.Sort
.SortFields.Clear
.SortFields.Add Key:=rngKey1
.SortFields.Add Key:=rngKey2
.SetRange rngSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
empStart = 2
With wsTest
For j = 0 To UBound(emps)
For k = empStart + 1 To lr
If .Range("d" & k).Value <> .Range("d" & k - 1).Value Then
empEnd = k - 1
writeRow = wsNew.Range("a" & Rows.Count).End(xlUp).Row + 1
If empStart = empEnd Then
For m = 1 To 5
wsNew.Cells(writeRow, m).Value = wsTest.Cells(k - 1, m).Value
Next m
Else
sumSal = 0
sumPer = 0
For n = empStart To empEnd
sumSal = sumSal + .Range("g" & n).Value
sumPer = sumPer + .Range("f" & n).Value
Next n
ftaNew = sumSal / sumPer
wsNew.Range("a" & writeRow).Value = wsTest.Range("a" & empStart).Value
wsNew.Range("b" & writeRow).Value = ftaNew
wsNew.Range("c" & writeRow).Value = 1
wsNew.Range("d" & writeRow).Value = wsTest.Range("d" & empStart).Value
wsNew.Range("e" & writeRow).Value = wsTest.Range("e" & empEnd).Value
wsNew.Range("f" & writeRow).Value = wsTest.Range("h" & empStart).Value
End If
empStart = empEnd + 1
Else
'else move on
End If
Next k
Next j
End With
End Sub
NOTE: This code is no different from first post; I could not see the "code" buttons (no text on them for some reason).
-
Mar 11th, 2014, 10:18 AM
#4
Thread Starter
Lively Member
Re: If employee has multiple rows for same period - VBA (EXCEL)
vbfbryce this code works perfect! After testing I noticed that I requested one thing incorrectly.
Im not sure if your code was meant to total the Days Excluded (col G) but the had not been totalled on the sheet("NEW")
anyhow
Column H (Days Excluded) is now "Days Worked" this needs totalling (when employee has multiple rows) then deducting from the number of days between the two dates.
Sorry to be a pain. Other than that it is working perfect! This is the final bit of the Project then its complete
-
Mar 11th, 2014, 10:37 AM
#5
Thread Starter
Lively Member
Re: If employee has multiple rows for same period - VBA (EXCEL)
Never mind managed to do it
Code:
Option Explicit
Sub copyToNew()
Dim wb As Workbook
Dim wsTest As Worksheet
Dim wsNew As Worksheet
Dim lr As Long
Dim wr As Long
Dim j As Long
Dim k As Long
Dim m As Integer
Dim n As Integer
Dim rngSort As Range
Dim rngKey1 As Range
Dim rngKey2 As Range
Dim emps() As String
Dim counter As Long
Dim empStart As Long
Dim empEnd As Long
Dim writeRow As Long
Dim sumSal As Long
Dim sumDays As Double
Dim sumPer As Double
Dim ftaNew As Double
Set wb = ActiveWorkbook
Set wsTest = wb.Worksheets("TESTING")
Set wsNew = wb.Worksheets("NEW")
lr = wsTest.Range("a" & Rows.Count).End(xlUp).Row
For j = 2 To lr
If wsTest.Range("a" & j).Value <> wsTest.Range("a" & j - 1).Value Then
ReDim Preserve emps(counter)
emps(counter) = wsTest.Range("a" & j).Value
counter = counter + 1
End If
Next j
Set rngSort = wsTest.Range("a1:h" & lr)
Set rngKey1 = wsTest.Range("a2:a" & lr)
Set rngKey2 = wsTest.Range("d2:d" & lr)
With wsTest.Sort
.SortFields.Clear
.SortFields.Add Key:=rngKey1
.SortFields.Add Key:=rngKey2
.SetRange rngSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
empStart = 2
With wsTest
For j = 0 To UBound(emps)
For k = empStart + 1 To lr
If .Range("d" & k).Value <> .Range("d" & k - 1).Value Then
empEnd = k - 1
writeRow = wsNew.Range("a" & Rows.Count).End(xlUp).Row + 1
If empStart = empEnd Then
For m = 1 To 5
wsNew.Cells(writeRow, m).Value = wsTest.Cells(k - 1, m).Value
Next m
Else
sumSal = 0
sumPer = 0
sumDays = 0
For n = empStart To empEnd
sumSal = sumSal + .Range("g" & n).Value
sumPer = sumPer + .Range("f" & n).Value
sumDays = sumDays + .Range("h" & n).Value
Next n
ftaNew = sumSal / sumPer
wsNew.Range("a" & writeRow).Value = wsTest.Range("a" & empStart).Value
wsNew.Range("b" & writeRow).Value = ftaNew
wsNew.Range("c" & writeRow).Value = 1
wsNew.Range("d" & writeRow).Value = wsTest.Range("d" & empStart).Value
wsNew.Range("e" & writeRow).Value = wsTest.Range("e" & empEnd).Value
wsNew.Range("f" & writeRow).Value = DateDiff("d", wsNew.Range("d" & writeRow).Value, wsNew.Range("e" & writeRow).Value) + 1 - sumDays
End If
empStart = empEnd + 1
Else
'else move on
End If
Next k
Next j
End With
End Sub
I can follow your code from "With wsTest" but dont get what is happening with the counter and stuff in the first part of the code.
Code:
For j = 2 To lr
If wsTest.Range("a" & j).Value <> wsTest.Range("a" & j - 1).Value Then
ReDim Preserve emps(counter)
emps(counter) = wsTest.Range("a" & j).Value
counter = counter + 1
End If
Next j
Would you be able to explain briefly?
Thanks again
Chris
-
Mar 11th, 2014, 11:06 AM
#6
Re: If employee has multiple rows for same period - VBA (EXCEL)
I defined an array variable in which to store the employee ID's. I'm re-dimming it (changing the size of it) every time a new employee ID is found. The first time its done, "counter" is zero. Since arrays are "zero-based," that's what we want the first one to be. Then we increment counter, so the next time through the loop one is the upper boundary (now 2 elements in the array). Make sense?
-
Mar 11th, 2014, 11:20 AM
#7
Thread Starter
Lively Member
Re: If employee has multiple rows for same period - VBA (EXCEL)
Kind of, in short are you counting the number of Employee's in the data?
After stepping through a few times I think I have kind of figured out what everything is doing
Will step through it a few more times tomorrow.
Pretty sure i will be able to get it to calculate the "Percentage worked", "ANNAUL Part-time salary", "Days worked" within the code.
Because you have probably noticed that following the results of TnTinMN's code i have added these 3 columns in.
EXCITED!! This has probably save around a months worth of manual work in total!
-
Mar 11th, 2014, 11:38 AM
#8
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Yes, counting the number of employees. Glad we could help!
-
Mar 11th, 2014, 02:26 PM
#9
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
I know I am late to the party, but this current data looks as though it is the same structure as the previous one with the exception of the three added columns. Assuming that is correct, the logic implemented in the prior solution already includes determining the number of records in each entry. You could just insert a new method call at line 91 (Call AddtoResults) of that code to write to this "NEW" worksheet as all the information is available at that point in the code (Employee #, start of record set, # records in set). That way you would only need to process the file once.
However, do whatever you are comfortable with supporting and make sure that you understand the logic as it is your baby now. Feel free to ask any questions you may have about the earlier code.
-
Mar 14th, 2014, 03:56 AM
#10
Thread Starter
Lively Member
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Strange, im not sure if it is because this thread is marked as resolved but i never got an email notification about these replies.
Hi TnTinMN, vbfbryce (could you guys not of used USERNAMES easier to remember/type haha) has created some code for the second part. I have managed to work out how his code works and have learnt a lot from it. When i have a couple of HOURS to spare i'm going to tackle figuring out how your code works
Then work on merging the two.
Thats the good thing about people helping me out, i'm not just asking for code to get the job done. If im asking for code i obviously dont know how to code it myself, so when i get the code i learn from it which makes my knowledge of vba that little bit stronger.
-
Mar 21st, 2014, 06:18 AM
#11
Thread Starter
Lively Member
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Sorry vbfbryce
After more vigorous testing the code doesnt seem to work for the final period of data.
If i have the following data i get no result
Employee Full time ANNUAL salary Monthly earnings Pay date from Pay Date to Percentage worked ANNAUL Part-time salary Days worked
310387 £31,924.00 £1,330.17 01/04/2013 30/04/2013 51% £16,184 15
310387 £27,864.00 £1,161.00 01/04/2013 30/04/2013 51% £14,126 15
If i add a line below this then it works but the final period is not calculated.
310387 £31,924.00 £1,330.17 01/04/2013 30/04/2013 51% £16,184 15
310387 £27,864.00 £1,161.00 01/04/2013 30/04/2013 51% £14,126 15
310387 £27,864.00 £1,161.00 01/05/2013 31/05/2013 49% £13,670 15
Please help this I need to get the code tested and working for 31st March
-
Mar 21st, 2014, 08:41 AM
#12
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Can you show us the most current code?
-
Mar 21st, 2014, 09:01 AM
#13
Thread Starter
Lively Member
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Of course, I have just added a bit to your original code that calculates the 3 additional columns (marked in red)
Code:
Option Explicit
Sub copyToNew()
Dim wb As Workbook
Dim wsTest As Worksheet, wsNew As Worksheet
Dim lr As Long, wr As Long, j As Long, k As Long
Dim m As Integer, n As Integer
Dim rngSort As Range, rngKey1 As Range, rngKey2 As Range
Dim counter As Long, empStart As Long, empEnd As Long
Dim writeRow As Long, sumSal As Long
Dim sumDays As Double, sumPer As Double, ftaNew As Double
Dim emps() As String
Dim f As Double
Set wb = ActiveWorkbook
Set wsTest = wb.Worksheets("TESTING")
Set wsNew = wb.Worksheets("NEW")
lr = wsTest.Range("a" & Rows.Count).End(xlUp).Row
For j = 2 To lr
'Percentage worked
f = wsTest.Range("B" & j) / 365 * (DateDiff("d", wsTest.Range("d" & j), wsTest.Range("e" & j)) + 1)
wsTest.Range("F" & j) = wsTest.Range("C" & j) / f * 1
'Annual P/T salary
wsTest.Range("G" & j).Value = wsTest.Range("B" & j).Value * wsTest.Range("F" & j)
'Days worked
wsTest.Range("H" & j).Value = wsTest.Range("C" & j).Value / wsTest.Range("B" & j).Value * 365
If wsTest.Range("a" & j).Value <> wsTest.Range("a" & j - 1).Value Then
ReDim Preserve emps(counter)
emps(counter) = wsTest.Range("a" & j).Value
counter = counter + 1
End If
Next j
Set rngSort = wsTest.Range("a1:h" & lr)
Set rngKey1 = wsTest.Range("a2:a" & lr)
Set rngKey2 = wsTest.Range("d2:d" & lr)
With wsTest.Sort
.SortFields.Clear
.SortFields.Add Key:=rngKey1
.SortFields.Add Key:=rngKey2
.SetRange rngSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
empStart = 2
With wsTest
For j = 0 To UBound(emps)
For k = empStart + 1 To lr
If .Range("d" & k).Value <> .Range("d" & k - 1).Value Then
empEnd = k - 1
writeRow = wsNew.Range("a" & Rows.Count).End(xlUp).Row + 1
If empStart = empEnd Then
For m = 1 To 5
wsNew.Cells(writeRow, m).Value = wsTest.Cells(k - 1, m).Value
Next m
Else
sumSal = 0
sumPer = 0
sumDays = 0
For n = empStart To empEnd
sumSal = sumSal + .Range("g" & n).Value
sumPer = sumPer + .Range("f" & n).Value
sumDays = sumDays + .Range("h" & n).Value
Next n
ftaNew = sumSal / sumPer
wsNew.Range("a" & writeRow).Value = wsTest.Range("a" & empStart).Value
wsNew.Range("b" & writeRow).Value = ftaNew
wsNew.Range("c" & writeRow).Value = 1
wsNew.Range("d" & writeRow).Value = wsTest.Range("d" & empStart).Value
wsNew.Range("e" & writeRow).Value = wsTest.Range("e" & empEnd).Value
wsNew.Range("f" & writeRow).Value = DateDiff("d", wsNew.Range("d" & writeRow).Value, wsNew.Range("e" & writeRow).Value) + 1 - sumDays
End If
empStart = empEnd + 1
End If
Next k
Next j
End With
End Sub
End Sub
-
Mar 21st, 2014, 09:29 AM
#14
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
I'm not sure I understand the condition (from #11) that causes the issue.
-
Mar 21st, 2014, 09:54 AM
#15
Thread Starter
Lively Member
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
No matter how much data there is the last period of dates in the list does not get processed by the code.
If you paste the data in #11 the first set of data will not process to the sheets "NEW"
the second set of data the period 01/04/2013 - 30/04/2013 will process but 01/05/2013 - 31/05/2013 will not.
Its just the LAST period of data that does not get processed. Unless you only have one period of data where nothing gets processed.
-
Mar 21st, 2014, 11:27 AM
#16
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Ok, could you zip and attach a book with a small amount of data that I can test it on? Or is something suitable already attached?
-
Mar 22nd, 2014, 01:17 PM
#17
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
I awoke to another frigid day here (7F), so I thought that I would take a look at this again. I have modified the original to add the three new columns to the grouping results and also added the new summary sheet.
Here is the result: Test Data (to submit).zip
-
Mar 24th, 2014, 04:57 AM
#18
Thread Starter
Lively Member
Re: [RESOLVED] If employee has multiple rows for same period - VBA (EXCEL)
Originally Posted by TnTinMN
I awoke to another frigid day here (7F), so I thought that I would take a look at this again. I have modified the original to add the three new columns to the grouping results and also added the new summary sheet.
Here is the result: Test Data (to submit).zip
Wow! everything in one go. I have just tested it with a small amount of data and it is working perfect.
Working in payroll means lots of deadlines and I have quiet a bit to do today. But will try get this tested with a large amount of data tomorrow.
Thanks again for all the time your guys have spent scratching your heads and putting this code together :P
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|