How can i extract the correct leave time on this code?

G

goncaloSX

New Member
Joined
Aug 30, 2023
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hello everyone
I've been recently given this VBA code


VBA 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
It works fairly well,but there is one problem when it comes to the leaving time
If an employee only enters once and leaves once it works well
however if an employee leaves more than once that's when we have a problem,the leaving time will always be the first leaving time

Check the pictures below to see what i mean (First picture is the block of information we paste onto the file before running the macro and the second picture is the output of the macro with the error circled)

d7TEs.png

2ziFt.png


I have no clue on how to fix this,if anyone could give me some tips/point me in the right direction i would really appreciate it
thanks for reading!
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
goncaloSX said:
Check the pictures below to see what i mean (First picture is the block of information we paste onto the file before running the macro and the second picture is the output of the macro with the error circled)
Click to expand...
The names and information in the picture above does not correlate to the picture below. Without data to experiment with, it is too difficult to see what is going on. FWIW, when you post an image of your data instead of something that can be copied and pasted into a spreadsheet, it is difficult for others to experiment with it. Which means your chances of getting help drop significantly. Instead, use the free XL2BB tool (link below) to post your data in a way that makes it accessible to others.

www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
189
DanteAmor
DanteAmor
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
168
shknbk2
S
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
322
kevin9999
K
N
  • Question
My code is suddenly really slow
Replies
1
Views
138
RobP
R
P
  • Solved
Recorded Macro Ammendments
Replies
3
Views
348
Joe4
Joe4

Forum statistics

Threads
1,215,073
Messages
6,122,970
Members
449,095
Latest member
Mr Hughes

Share this page

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 MrExcel.com.
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 "mrexcel.com".
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
Back
Top