Please help me to solve issue with excel VBA code. I need to run a different IF statement when the date equals Saturday.
Code and statements are given below
Sub Attendance()
Dim Column_I_I As Long
Column_I_I = Range("A" & Rows.Count).End(xlUp).Row
Range("I2").Formula = "=E2-D2"
Range("I2").AutoFill Destination:=Range("I2:I" & Column_I_I), Type:=xlFillSeries
ActiveSheet.Calculate
Columns("I:I").Copy
Columns("I:I").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Columns("I:I").Select
Selection.NumberFormat = "hh:mm"
Columns("I:I").Select
Selection.Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Columns("D:E").Select
Selection.NumberFormat = "h:mm:ss;@"
Columns("F:F").Select
Selection.NumberFormat = "h:mm:ss"
Columns("G:G").Select
Selection.NumberFormat = "h:mm:ss"
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Dim Column_F_F As Long
Column_F_F = Range("A" & Rows.Count).End(xlUp).Row
Range("F2").Formula = "=IF(AND(D2>=TIME(8,16,0),D2<=TIME(10,30,0)),D2-TIME(8,0,0),IF(AND(D2>=TIME(12,16,0),D2>=TIME(10,31,0)),D2-TIME(12,0,0)*1,0))"
Range("F2").AutoFill Destination:=Range("F2:F" & Column_F_F), Type:=xlFillSeries
ActiveSheet.Calculate
Columns("F:F").Copy
Columns("F:F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells.Replace What:="12:00:00 AM", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Dim Column_G_G As Long
Column_G_G = Range("A" & Rows.Count).End(xlUp).Row
Range("G2").Formula = "=IF(AND(E2<=TIME(15,59,0),D2<=TIME(10,29,0)),TIME(16,0,0)-E2,IF(AND(E2<=TIME(19,59,0),D2>=TIME(10,31,0)),TIME(20,0,0)-E2*1,1))"
Range("G2").AutoFill Destination:=Range("G2:G" & Column_G_G), Type:=xlFillSeries
ActiveSheet.Calculate
Columns("G:G").Copy
Columns("G:G").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Columns("D:E").Select
Selection.NumberFormat = "hh:mm"
Columns("F:F").Select
Selection.NumberFormat = "hh:mm"
Columns("G:G").Select
Selection.NumberFormat = "hh:mm"
Selection.Replace What:="4:00:00 PM", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="8:00:00 PM", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("H:H").Select
Selection.Replace What:="True", Replacement:="Absent", LookAt _
:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Cells.Select
Cells.EntireColumn.AutoFit
Range("a1").Select
'
iRow = 2
'
Do
'
If Cells(iRow + 1, 1) <> Cells(iRow, 1) Then
Cells(iRow + 1, 1).EntireRow.Insert shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, 1).Text = ""
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "@"
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
End Sub
When the day is Saturday in column C (C2:C) I need below formula to replace the one in above code.
Dim Column_F_F As Long
Column_F_F = Range("A" & Rows.Count).End(xlUp).Row
Range("F2").Formula = "=IF(AND(D2>=TIME(9,16,0),D2<=TIME(11,59,0)),D2-TIME(9,0,0),IF(AND(D2>=TIME(14,16,0),D2>=TIME(12,00,0)),D2-TIME(14,0,0)*1,0))"
Range("F2").AutoFill Destination:=Range("F2:F" & Column_F_F), Type:=xlFillSeries
ActiveSheet.Calculate
Columns("F:F").Copy
Columns("F:F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells.Replace What:="12:00:00 AM", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Dim Column_G_G As Long
Column_G_G = Range("A" & Rows.Count).End(xlUp).Row
Range("G2").Formula = "=IF(AND(E2<=TIME(13,59,0),D2<=TIME(11,59,0)),TIME(14,0,0)-E2,IF(AND(E2<=TIME(19,59,0),D2>=TIME(12,00,0)),TIME(20,0,0)-E2*1,1))"
Range("G2").AutoFill Destination:=Range("G2:G" & Column_G_G), Type:=xlFillSeries
ActiveSheet.Calculate
Columns("G:G").Copy
Columns("G:G").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
I am not a VBA programmer, I created the above code by tutorials and forums. please help.
Thanks in advance, Jagadeesh Balakrishnan
Aucun commentaire:
Enregistrer un commentaire