简体   繁体   中英

2D For Loop used on a Staff Leave Calendar

this is the first time I have ever posted in a forum so please forgive me if I slip up with protocols and be a little patient with me.

I am completely self taught where coding is concerned and have always managed to find my answers from other peoples posts in the past. This current problem is vexing me though because I just do not understand enough about VBA to see the solution. The code as it stands now spits out a "Run-time error '1004': Application-defined or object-defined error" I have tried researching this error also and found many answers on the topic but am not sure how to apply them to my code. I am fairly sure I will need to add a "With" in there but I would like some professional help with it before I mess with the code too much more.

The purpose behind my code is to match names on a Calendar in Sheet2 (Current Staff list) to a growing list of Names where staff are requesting leave in Sheet1 . Where there is a match I want to check the row on Sheet2 which contains calendar dates whether it is >= a leave start date AND <= a leave end date. Then highlight the cells where this is true. Then it needs to continue checking the same row on Sheet2 against the list of names on Sheet1 to find additional matches and do the same actions.

Sub Highlight_Calendar()

    Dim lRow1 As Long
    lRow1 = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
    Dim lRow2 As Long
    lRow2 = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
    Dim lCol2 As Long
    lCol2 = Worksheets("Sheet2").Cells(lRow2, Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
    Dim ArrS2Names() As Variant
    ArrS2Names = Sheet2.Range("A3", Worksheets("Sheet2").Cells(lRow2, 1))
    Dim ArrS1Names() As Variant
    ArrS1Names = Sheet1.Range("A3", Worksheets("Sheet1").Cells(lRow1, 1))
    Dim calendarArr() As Variant
    calendarArr = Sheet2.Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2))
    Dim firstArr() As Variant
    firstArr = Sheet1.Range("C3:C" & lRow1)
    Dim lastArr() As Variant
    lastArr = Sheet1.Range("D3:D" & lRow1)

    Dim R1 As Long
    Dim R2 As Long
    Dim C2 As Long

    For R2 = LBound(ArrS2Names, 1) To UBound(ArrS2Names, 1)
        For R1 = LBound(ArrS1Names, 1) To UBound(ArrS1Names, 1)
            For C2 = LBound(calendarArr, 2) To UBound(calendarArr, 2)
                If ArrS2Names(R2, 1) = ArrS1Names(R1, 1) Then
                    Debug.Print (ArrS2Names(R2, 1))
                    If calendarArr(R2, C2) >= firstArr(R1, 1) And calendarArr(R2, C2) <= lastArr(R1, 1) Then
                        Sheet2.Cells(R2, C2).Interior.Color = RGB(0, 255, 0)
                        Debug.Print (Sheet2.Cells(R2, C2))
                    End If
                End If
            Next C2
        Next R1
    Next R2
End Sub

Whoop!! I have finally found the answers I needed for this, and while it is fairly simple functionally, I had no idea what questions to ask so it has been a rather gruelling task to complete. For anyone who comes after, hopefully my code will help answer some questions.

A really big thank you to all who helped and a special thank you to Chris Neilson for giving me the guidance and clarity to find my own answers. You may never know how much your comment of "do more research on how Range works" actually helped. I didn't realise how little I understood about ranges. Unfortunately I didn't keep a copy of the first code I posted, so the one in the question is fairly close to the final result due to edits. I am not sure how to vote up discussions yet, but will look into this and vote up those who helped.

Sub Highlight_Calendar()

    Dim lRow1 As Long
    lRow1 = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
    Dim lRow2 As Long
    lRow2 = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
    Dim lCol2 As Long
    lCol2 = Worksheets("Sheet2").Cells(lRow2, Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
    Dim ArrS2Names() As Variant
    ArrS2Names = Sheet2.Range("A3", Worksheets("Sheet2").Cells(lRow2, 1))
    Dim ArrS1Names() As Variant
    ArrS1Names = Sheet1.Range("A3", Worksheets("Sheet1").Cells(lRow1, 1))
    Dim calendarArr() As Variant
    calendarArr = Sheet2.Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2))
    Dim firstArr() As Variant
    firstArr = Sheet1.Range("C3:C" & lRow1)
    Dim lastArr() As Variant
    lastArr = Sheet1.Range("D3:D" & lRow1)

    Dim R1 As Long
    Dim R2 As Long
    Dim C2 As Long

    For R2 = LBound(ArrS2Names, 1) To UBound(ArrS2Names, 1)
        For R1 = LBound(ArrS1Names, 1) To UBound(ArrS1Names, 1)
            For C2 = LBound(calendarArr, 2) To UBound(calendarArr, 2)
                If ArrS2Names(R2, 1) = ArrS1Names(R1, 1) Then
                    Debug.Print (ArrS2Names(R2, 1))
                    If calendarArr(R2, C2) >= firstArr(R1, 1) And calendarArr(R2, C2) <= lastArr(R1, 1) Then
                        Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2)).Cells(R2, C2).Interior.Color = RGB(0, 255, 0)
                        Debug.Print Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2)).Cells(R2, C2)
                    End If
                End If
            Next C2
        Next R1
    Next R2
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM