Extract correct leave time (1 Viewer)

G

goncalo

Member
Local time
Today, 10:26
Joined
May 23, 2023
Messages
51
Hello everyone
i recently got sent the following code


Code: 
Sub ENTRADAS_SAIDAS()
   
    Application.ScreenUpdating = False

   'Beginning

    Range("A1").Select
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.Zoom = 85
    ActiveWindow.DisplayGridlines = False
    Range("A2").Select
    Selection.End(xlUp).Select
    Selection.End(xlToRight).Select
    Rows("1:1").Select
     
   
    'Concatenate Labortype with Employee#
 
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[4],""-"",RC[3])"
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Columns("A:A").EntireColumn.Select
    ActiveCell.Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
       
    'Concatenate Name with Surname & delete unnecessary columns
   
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(1, 1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=+CONCATENATE(RC[1],"" "",RC[2])"
    ActiveCell.Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveCell.Columns("A:A").EntireColumn.Select
    ActiveCell.Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   
    'Extract CC & format entry time
           
    ActiveCell.Offset(0, 1).Columns("A:D").EntireColumn.Select
    ActiveCell.Offset(0, 1).Range("A1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    ActiveCell.Columns("A").EntireColumn.Select
    ActiveCell.Activate
    Selection.Insert Shift:=xlToRight
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VALUE(MID(RC[-1],5,4)),MID(RC[-1],5,4))"
    ActiveCell.Activate
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlUp).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "CC"
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
    Selection.Delete Shift:=xlToLeft
    Selection.End(xlToRight).Select
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.NumberFormat = "dd/mm/yy hh:mm;@"
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter


    'Extract leaving time

    ActiveCell.Select
    Selection.End(xlToRight).Select
    ActiveCell.FormulaR1C1 = "Entrada"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Saída"
    Columns("A:G").EntireColumn.Select
    Selection.AutoFilter Field:=5, Criteria1:=Array( _
        "*TOR*SA*DA*"), Operator:= _
        xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Application.Goto Reference:="R10000C1"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Rows("2:2").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    Range("A2").Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC2,R9000C2:R20000C7,5,FALSE)"
    ActiveCell.Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A2").Select
    Selection.End(xlUp).Select
    Selection.End(xlToRight).Select
    ActiveCell.FormulaR1C1 = "Saída"
    ActiveCell.Columns("A:A").EntireColumn.Select
    ActiveCell.Offset(1, 0).Range("A1").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    Rows("1:1").Select
    Selection.Font.Bold = True
    Range("A2").Select
    ActiveCell.Columns("E:E").EntireColumn.Delete
    ActiveCell.Columns("A:F").EntireColumn.AutoFit
   
   
    'Conditional format for records with the same name
   
    ActiveCell.Columns("C:C").EntireColumn.Select
    ActiveCell.Activate
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

     
    'Dates formating
   
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(TEXT(RC[-8],""aaaa-m-dd h:mm""))"
    Selection.Copy
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Offset(0, -1).Range("A1:B1").Select
    ActiveCell.Activate
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 7).Range("A1:B1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlToLeft).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "d/m/yy h:mm;@"
    ActiveCell.Offset(0, 8).Columns("A:B").EntireColumn.Select
    Selection.Delete Shift:=xlToLeft


    'OT Business Day % Formula input
   
    Range("A2").Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(-1, 1).Activate
    ActiveCell = "OT BusDay %"
    ActiveCell.Offset(1, 0).Activate
    ActiveCell.FormulaR1C1 = "=+((RC[-1]-RC[-2])*24-0.5)/8"
    Selection.Copy
    ActiveCell.Offset(0, -1).Activate
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Activate
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("G:G").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.Select
    Selection.Cut
    ActiveCell.Offset(0, -2).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    Range("A2").Select

    Application.ScreenUpdating = True

End Sub

this macro calculates a bunch of stuff,however i need to make a change to it
and that change is to make it so that the correct leave time is extracted
the code only seems to extract the first leave time,so for example if a employee leaves more than once it will only display the first leave time and not the correct leave time

can anyone help me out?
 
Ranman256

Ranman256

Well-known member
Local time
Today, 05:26
Joined
Apr 9, 2015
Messages
4,337
which leave time IS the correct leave time?
 
G

goncalo

Member
Local time
Today, 10:26
Joined
May 23, 2023
Messages
51
well it depends on the entry time
below ill post 2 images
the first one is the block of information we paste onto the file before we run the macro and the second image is the output after the macro is ran(ill circle around a case where the leave time is not displayed correctly)

As you can imagine no one can enter at 19:57 and leave at 19:54 (unless you're The Flash or somethin)
The first circle has no issue,but the cell with the second circle has issues,the code just grabbed the first leave time and pasted it onto there
The thing is though that on the first image i sent is all the information used to run the macro,and in that information it has the CORRECT entry and leave times,but when this macro is executed i guess it only takes the first leave time into account
 
Last edited:
You must log in or register to reply here.

Similar threads

D
Solved Formatting Excel File from Access
Replies
5
Views
740
Eugene-LS
Eugene-LS
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
525
BlueFllame
B
J
Solved Convert An Excel Macro To Run In Access VBA
Replies
12
Views
1,363
jo15765
J
B
Error on auto-update of a pivot table cache
Replies
4
Views
1,394
Boromyr
B
P
VBA compiler can't see For statement?
Replies
5
Views
855
The_Doc_Man
The_Doc_Man

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom