dimanche 3 février 2019

Excel VBA - If and Then

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