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.