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

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
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

D
  • Solved
Insert formula in last column macro
2
Replies
13
Views
215
MARK858
MARK858
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
653
dinunan
D
S
  • Solved
VBA autofilling code
Replies
6
Views
597
Peter_SSs
Peter_SSs
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
441
myall_blues
myall_blues
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R

Forum statistics

Threads
1,224,813
Messages
6,181,112
Members
453,021
Latest member
Justyna P

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