Solved

VBA Code to insert a new line and start a new period when workdays are not consecutive.

Posted on 2015-01-15
9
183 Views
Last Modified: 2015-01-18
The purpose with this procedure is based on an employee list with daily records of the type of days that the employee is not working to generate a list that for each employee and each type of worktype to generate a list with the following 7 columns:

employeenumber, employeename, socialsecuritynumber, worktype, first day off, last day off, number of consecutive days

This is solved as I copy columns B to E from worksheet "Sheet2" to the worksheet "Ark1", then I remove all duplicate records from Worksheet "Ark1". this is followed by inserting two array formulas in column E and F to find the earliest and latest dates for each combination of employee and worktype.

Then I insert a calculation of number of days and a calculation of the consecutive workdays.

This all works well.

Here is the problem that I have to solve. because once in a while an employee has three days of vacation (ferie in Danish),
but those days are separated from each other. I need to create a new row, that is inserted everytime the number of days are not consecutive (see line 17 and 18 for an example) and then I need to have a start and end date for that second (third and fourth period) as well.

I have tried a bit with the small function instead of the Min function, which might Work, but I am stuck, as I need the VBA to recognize that this is a new record, and therefore a new line.

regards

Jørgen
Experts-Exchange-Repeats.xlsm
0
Comment
Question by:Jorgen
  • 5
  • 2
  • 2
9 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 40552961
Sorry I am confused.

You want us to verify the code and make amendments ? or. .. what ?
the code works how it is and how and when to activate it ?

gowflow
0
 
LVL 4

Author Comment

by:Jorgen
ID: 40553021
Hi Gowflow,

The code works fine.

But I need to be able to do some amendment to the code.

If an employee has more than one period within the month with the same kind of worktype, then I have not been able to solve how to handle that
If you take the Rows 13 to 18 in sheet2, you should have 3 records

2058, Flemming Olsen, Ferie,    17-11-2014,   20-11-2014
2061. Peter Dahl,           Ferie,     03-11-2014,  03-11-2014
2061. Peter Dahl,           Ferie,     17-11-2014,  17-11-2014

not like it is now (see below)

2058, Flemming Olsen, Ferie,    17-11-2014,   20-11-2014
2061. Peter Dahl,           Ferie,     03-11-2014,  17-11-2014

regards

Jørgen
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40553276
Sorry you must be talking a language I don't understand:


You say records in sheet2 13 to 18 3 records
2058, Flemming Olsen, Ferie,    17-11-2014,   20-11-2014
2061. Peter Dahl,           Ferie,     03-11-2014,  03-11-2014
2061. Peter Dahl,           Ferie,     17-11-2014,  17-11-2014

But what I see in the file you posted in 13 to 18 is this in sheet2
17-11-2014      2058      Flemming Olsen
18-11-2014      2058      Flemming Olsen
19-11-2014      2058      Flemming Olsen
20-11-2014      2058      Flemming Olsen
03-11-2014      2061      Peter Dahl
17-11-2014      2061      Peter Dahl


Then when I run the macro it build sheet Ark2 the data with 1 row per name putting the dates from the latest to the oldest in Start Slut and a total of days in Col G that seems to be fine at a first look.

What seems not ok is the col H that have this formula
=NETWORKDAYS.INTL(E2,F2)+G2
that give an error NAME? as the function NETWORKDAYS.INTL is not recognized.

So what is the problem I do not see your 3 records ending in 2 as you mentioned and what about the formula error.

Kindly check the file you attached and maybe it is not the correct one or then pls clarify.
gowflow
0
 
LVL 4

Author Comment

by:Jorgen
ID: 40553328
Hi Gowflow,

Sorry if I am unclear.

in sheet2 I have the dataset, that I want to convert to new records in Ark2. Those records should look like shown above.

that means that those 6 rows of data from the source sheet ("Sheet2) should generate 3 rows of data in the destination sheet ("Ark2"). At the moment I only generate 2 rows of data in the destination sheet. I need to generate two records for  Peter Dahl, as the days is not next to each other in the calendar.

I do not get any errors in the formula calculating working days. but that formula is just used as a control cell to match up against the column G
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 21

Accepted Solution

by:
Ejgil Hedegaard earned 500 total points
ID: 40553929
Try this code instead.
It is in Module 2 in the workbook.
Press the button to run the macro.

Option Explicit
Dim wsIn As Worksheet, wsOut As Worksheet
Dim rwIn As Long, rwInMax As Long, rwOut As Long, col As Integer
Dim DataRange As Range
Dim Days As Single

Sub ArrangeEmployees()
        
    Set wsIn = Sheets("Sheet2")
    Set wsOut = Sheets("Ark2")
    
    Application.ScreenUpdating = False
    
    wsOut.Cells.ClearContents
    wsOut.Range("A1:H1") = Array("Løn nr", "Medarbejder", "CPR", "Konto", "Start", "Slut", "Dage", "Arbejdsdage")
    rwInMax = wsIn.Range("A1").CurrentRegion.Rows.Count
    Set DataRange = wsIn.Range(Cells(1, 1), Cells(rwInMax, wsIn.Range("A1").CurrentRegion.Columns.Count))
    DataRange.Sort Key1:="Løn nr", Order1:=xlAscending, Key2:="Dato", Order2:=xlAscending, Header:=xlYes
    
    rwIn = 1
    rwOut = 1
    NewLine
    
    For rwIn = 2 To rwInMax
        If wsIn.Range("B" & (rwIn + 1)) = wsIn.Range("B" & rwIn) _
          And wsIn.Range("E" & (rwIn + 1)) = wsIn.Range("E" & rwIn) _
          And wsIn.Range("A" & (rwIn + 1)) = wsIn.Range("A" & rwIn) + 1 Then
            Days = Days + wsIn.Range("F" & (rwIn + 1))
        Else
            wsOut.Range("F" & rwOut) = wsIn.Range("A" & rwIn)
            wsOut.Range("G" & rwOut) = Days
            wsOut.Range("H" & rwOut) = Application.WorksheetFunction.NetworkDays(wsOut.Range("E" & rwOut), wsOut.Range("F" & rwOut))
            If rwIn < rwInMax Then
                NewLine
            End If
        End If
    Next rwIn
    wsOut.Select
    wsOut.Columns.AutoFit
    Application.ScreenUpdating = True
    wsOut.Range("A1").Select
    
End Sub

Sub NewLine()
    rwOut = rwOut + 1
    For col = 2 To 5
        wsOut.Cells(rwOut, col - 1) = wsIn.Cells(rwIn + 1, col)
    Next col
    wsOut.Range("E" & rwOut) = wsIn.Range("A" & (rwIn + 1))
    Days = wsIn.Range("F" & (rwIn + 1))
End Sub

Open in new window

Experts-Exchange-Repeats-A.xlsm
0
 
LVL 4

Author Comment

by:Jorgen
ID: 40554857
Hi Eigil

That seems to work great.

And a completely different approach, than the one I took in the first place.

VBA is not my main area, so hopefully I will learn a lot from your code, and therefore I have tried to comment on What you are actually doing.

Option Explicit
Dim wsIn As Worksheet, wsOut As Worksheet
Dim rwIn As Long, rwInMax As Long, rwOut As Long, col As Integer
Dim DataRange As Range
Dim Days As Single

Sub ArrangeEmployees()
        
    Set wsIn = Sheets("Sheet2")
    Set wsOut = Sheets("Ark2")
    
    Application.ScreenUpdating = False
    
    'Clear the contents of the destination sheet
    wsOut.Cells.ClearContents
    
    'Set the headers of destination sheet
    wsOut.Range("A1:H1") = Array("Løn nr", "Medarbejder", "CPR", "Konto", "Start", "Slut", "Dage", "Arbejdsdage")
    
    'Count the rows in the source sheet
    rwInMax = wsIn.Range("A1").CurrentRegion.Rows.Count
    
    'Define the size of the input DataRange and sets it as range
    Set DataRange = wsIn.Range(Cells(1, 1), Cells(rwInMax, wsIn.Range("A1").CurrentRegion.Columns.Count))
    'Sort the DataRange based on first Løn nr. and afterwards Dato in Ascending Order
    DataRange.Sort Key1:="Løn nr", Order1:=xlAscending, Key2:="Dato", Order2:=xlAscending, Header:=xlYes
    
    rwIn = 1
    rwOut = 1
    'run the subprocedure NewLine to put in the information from the destination sheet
    NewLine
    
    For rwIn = 2 To rwInMax      'repeat until you reach the bottom of the sourcesheet or actually the datarange set
        
        'If the value of the "lønnr" and the "Konto" in the cell below equals the value of the "lønnr" and "Konto" on the
        'row we check and the day below is one larger, than the row we check then we increase the Days counter
        If wsIn.Range("B" & (rwIn + 1)) = wsIn.Range("B" & rwIn) _
          And wsIn.Range("E" & (rwIn + 1)) = wsIn.Range("E" & rwIn) _
          And wsIn.Range("A" & (rwIn + 1)) = wsIn.Range("A" & rwIn) + 1 Then
            Days = Days + wsIn.Range("F" & (rwIn + 1))
        Else
            ' if one of the three statements above is not true then "Slut" column will equal the date from colomn A in sourcesheet
            wsOut.Range("F" & rwOut) = wsIn.Range("A" & rwIn)
            ' in column G you insert the number of Days
            wsOut.Range("G" & rwOut) = Days
            'and you insert the formula for netWorkDays in column H based on the days in Column E and F
            wsOut.Range("H" & rwOut) = Application.WorksheetFunction.NetworkDays(wsOut.Range("E" & rwOut), wsOut.Range("F" & rwOut))
            
            ' If We are not at the bottom of our sourcesheet, we should go to the next record, and run the subprocedure NewLine
            If rwIn < rwInMax Then
                NewLine
            End If
        End If
    Next rwIn
    
    'Select the destination sheet and autofit all columns - Unfreeze ScreenUpdating and select cell A1 in destination sheet
    wsOut.Select
    wsOut.Columns.AutoFit
    Application.ScreenUpdating = True
    wsOut.Range("A1").Select
    
End Sub

Sub NewLine()
    'add 1  to rwOut counter
    rwOut = rwOut + 1
    For col = 2 To 5
        'inserts values from column B to E from source sheet in column A to D in destination sheet
        wsOut.Cells(rwOut, col - 1) = wsIn.Cells(rwIn + 1, col)
    Next col
    'In column E you insert the startdate, that you find in column A
    wsOut.Range("E" & rwOut) = wsIn.Range("A" & (rwIn + 1))
    '???????
    Days = wsIn.Range("F" & (rwIn + 1))
End Sub

Open in new window


and I have a couple of questions

How are you working with the days counter, and as a couple of the employees are not on full time is it possible to change the declaration from single to something that can handle that?

And by the way, from your name you seem to be a fellow dane, so it is always great to know that another Dane is writing such great code :-)

regards
Jørgen
0
 
LVL 21

Expert Comment

by:Ejgil Hedegaard
ID: 40555387
Hi Jørgen

You are right, I am from Denmark.
Thanks for the roses :-)
Click my name above, where you can see a little information about me.
VBA is learning by doing, and getting help from others, feel free to contact me if you want.

I decided to use another approach, instead of rewriting the code, for mainly these reasons.
Calculating array formulas for entire columns are very time consuming, also after the code finish.
The formulas could be set to only the uses data range, to speed up the calculations, but is not needed, since VBA can do the calculations, and only insert the results.
Building one row at a time is easier, than finding positions, inserting rows and values after copy and cleanup.
You have a lot of selections which slows down the program, and selections are quite often not needed.
And as you see, the program only takes a split second to complete.

Your comments very well describe what is happening, except for the variable Days (see below), and the function networkdays.
No formulas are inserted for networkdays, only the result from the calculation.
Perhaps holidays are automatically excluded in the data, but if not, it is possible to make a list and use that in the function.

Sorting the data can be omitted if always like shown, but to be sure I added the sorting.
It is not that important, since sorting is fast, except for very large datasets.
Setting a variable for the sorting range is not needed, but I find it easier to read.

The variable Days is initialised with the value in Kost when a new line is added.
Then values are added until last record in that period for the employee and absence type.
It is not a counter, values are from the Kost column.
It is set to single because some of the values are decimal values.
What do you mean by changing the declaration to handle that some employees are not working full time?
I don't see information in the data for the normal work time.

If a person has more than one work place, and you want to get the complete absence for the person, consider using CPR as identification instead of Løn nr.

Regards
Ejgil
0
 
LVL 4

Author Comment

by:Jorgen
ID: 40556042
Hi Ejgil

Great with all the small tips on writing the code. I absolutely agree with you on the array formulas.

I used the step into the code to see how your Days counter worked, so now I understand that part of the code as well, and again I must say I like the way you have solved this.

I am aware of the holidays list, that I can use in Networkingdays, and that will be added, when I have discussed with the salary department how we are treating special Danish holidays like Grundlovsdag etc.

The issue on days is the situation, that we have in cell F44 of the source sheet (Sheet2), where we have 1.25 instead of 1, which I tried to find a way to flag for the salary department. But after understanding how your Days counter works, that is not an issue any longer.

I have looked into your profile, and I surely will look into some of your previous answers to get further inspiration.

And I will get in touch, if and when I have interesting issues.

I have updated my comments to reflect your comments, and at least now I fully understand, what your code is doing, and hopefully some of our fellow members of Experts Exchange will be inspired as well.

Option Explicit
Dim wsIn As Worksheet, wsOut As Worksheet
Dim rwIn As Long, rwInMax As Long, rwOut As Long, col As Integer
Dim DataRange As Range
Dim Days As Single

Sub ArrangeEmployees()
        
    Set wsIn = Sheets("Sheet2")
    Set wsOut = Sheets("Ark2")
    
    Application.ScreenUpdating = False
    
    'Clear the contents of the destination sheet
    wsOut.Cells.ClearContents
    
    'Set the headers of destination sheet
    wsOut.Range("A1:H1") = Array("Løn nr", "Medarbejder", "CPR", "Konto", "Start", "Slut", "Dage", "Arbejdsdage")
    
    'Count the rows in the source sheet
    rwInMax = wsIn.Range("A1").CurrentRegion.Rows.Count
    
    'Define the size of the input DataRange and sets it as range
    Set DataRange = wsIn.Range(Cells(1, 1), Cells(rwInMax, wsIn.Range("A1").CurrentRegion.Columns.Count))
    'Sort the DataRange based on first Løn nr. and afterwards Dato in Ascending Order
    DataRange.Sort Key1:="Løn nr", Order1:=xlAscending, Key2:="Dato", Order2:=xlAscending, Header:=xlYes
    
    rwIn = 1
    rwOut = 1
    'run the subprocedure NewLine to put in the information from the destination sheet
    NewLine
    
    For rwIn = 2 To rwInMax      'repeat until you reach the bottom of the sourcesheet or actually the datarange set
        
        'If the value of the "lønnr" and the "Konto" in the cell below equals the value of the "lønnr" and "Konto" on the
        'row we check and the day below is one larger, than the row we check then we increase the Days counter with the value
        'in column F Row (rwIn + 1), and continue counting Days
        'We do not read further information into the destination source until above statement is met (We just increase the
        'Days counter), and then we increase the counter. When above statement is met we inserts the date from Column A in the
        'Source sheet in column F of the destination sheet, and column G equals the variable Days.
        
        If wsIn.Range("B" & (rwIn + 1)) = wsIn.Range("B" & rwIn) _
          And wsIn.Range("E" & (rwIn + 1)) = wsIn.Range("E" & rwIn) _
          And wsIn.Range("A" & (rwIn + 1)) = wsIn.Range("A" & rwIn) + 1 Then
            Days = Days + wsIn.Range("F" & (rwIn + 1))
        Else
            ' if one of the three statements above is not true then "Slut" column will equal the date from colomn A in sourcesheet
            wsOut.Range("F" & rwOut) = wsIn.Range("A" & rwIn)
            ' in column G you insert the number of Days
            wsOut.Range("G" & rwOut) = Days
            'and you insert the value of the formula for netWorkDays in column H based on the days in Column E and F
            'This code still needs to be updated by a list of Public Holidays
            wsOut.Range("H" & rwOut) = Application.WorksheetFunction.NetworkDays(wsOut.Range("E" & rwOut), wsOut.Range("F" & rwOut))
            
            ' If We are not at the bottom of our sourcesheet, we should go to the next record, and run the subprocedure NewLine
            If rwIn < rwInMax Then
                NewLine
            End If
        End If
    Next rwIn
    
    'Select the destination sheet and autofit all columns - Unfreeze ScreenUpdating and select cell A1 in destination sheet
    wsOut.Select
    wsOut.Columns.AutoFit
    Application.ScreenUpdating = True
    wsOut.Range("A1").Select
    
End Sub

Sub NewLine()
    'add 1  to rwOut counter
    rwOut = rwOut + 1
    For col = 2 To 5
        'inserts values from column B to E from source sheet in column A to D in destination sheet
        wsOut.Cells(rwOut, col - 1) = wsIn.Cells(rwIn + 1, col)
    Next col
    'In column E you insert the startdate, that you find in column A
    wsOut.Range("E" & rwOut) = wsIn.Range("A" & (rwIn + 1))
    ' resets the Days counter so it just sums the value in the cell to insert in the destination sheet
    Days = wsIn.Range("F" & (rwIn + 1))
End Sub

Open in new window


regards

Jørgen
0
 
LVL 4

Author Closing Comment

by:Jorgen
ID: 40556045
Great solution,

The solution both improved my own approach significantly, and Ejgil took the time to explain why he took a different approach, and how that can improve my coding in the future.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now