Code:
'440 'Must Loop to get interior color as this will not work. ' ## ' Let arrDteClr() = FstDtaCel.Offset(0, 4).Resize(lr, 1).Interior.Color ' because .Interior property for a Range object shows only one value for the entire range which seems to be zero unless all the cells have a colour
450 Dim arrDteClr() As Double, rngDts As Range
460 Set rngDts = FstDtaCel.Offset(0, 4).Resize(lr, 1)
470 Dim Rws As Long: ReDim arrDteClr(1 To lr, 1 To 1) ' so must loop in each Interior color value
480 For Rws = 1 To UBound(arrDteClr(), 1) Step 1 'InnerLoop for dates background colors
490 Let arrDteClr(Rws, 1) = rngDts.Item(Rws, "A").Interior.Color
500 Next Rws
510 '3c) Inner loop for rows
520 Dim ShtCnt As Long ' Loop Bound Variable Count for hours columns looping
530 Dim ValidHoliday As Boolean: Let ValidHoliday = True 'Assume for now Holiday days are valid for Holiday adjustments
540 For ShtCnt = 1 To UBound(arrDteClr(), 1) Step 1 '------------------- For "rows" in data arrays
550 '3d) We need to check Interior color, and a few other things, Adjust columns I and J so that column I has no hours for holiday day and total hours goes to over time hours with criteria 9 or less than 9 hrs all total hours added overtime, 10 or above 10 hrs one hour deducted from total hours and added to column J ..... and add a H or N in helper column K
560 If arrDteClr(ShtCnt, 1) = 65535 Then ' We have a Holiday, ...but... have some other checks
570 If Not (ShtCnt = 1 Or ShtCnt = UBound(arrDteClr(), 1)) Then ' ....but... Possible futher checks for not adjusting Normal Total Hrs to overtime and remove normal Hrs
580 'It is possible to check for absent before and after current day
590 If arrTotHrs(ShtCnt - 1, 1) = Empty And arrTotHrs(ShtCnt + 1, 1) = Empty Then '...."...holiday is deducted if the person does not come the day before and after the holiday...".... To facilitate this "ABSENT" is written in column K so that 30 - CountIf ABSENT will "remove a Holiday pay"
600 Let ValidHoliday = False
610 Else
620 Let ValidHoliday = True
630 End If
640 Else 'It is not possible for absence before AND after to check for absence as one will lie in last or next month
650 End If ' We remmain at default or last set true or just set true or false
660 'We had Holiday ...
670 If ValidHoliday = True Then ' ...and all conditions for valid Holiday pay adjustments
680 'Conditions met to adjust make all of 1 less of Normal Hrs to overtime
690 If (arrTotHrs(ShtCnt, 1) * 24) <= 9 Then '(i) If Total Hrs are less than or equal to 9 ,Then all Total Hrs are added to Overtime Hrs
700 Let arrInOver(ShtCnt, 1) = arrTotHrs(ShtCnt, 1) ' Given To ' Added to arrInOver(ShtCnt, 1) + arrTotHrs(ShtCnt, 1)
710 ElseIf (arrTotHrs(ShtCnt, 1) * 24) > 9 Then ' (ii) If Total Hrs are less greater than 9 , Then ( Total Hrs - 1 ) are added to Overtime Hrs
720 Let arrInOver(ShtCnt, 1) = arrTotHrs(ShtCnt, 1) - 1 / 24 ' Given To ' arrInOver(ShtCnt, 1) + arrTotHrs(ShtCnt, 1) - 1 / 24 'Added to 1 hr less overtime for more than 9 hrs worked
730 End If
740 Let arrInNorm(ShtCnt, 1) = Empty ' (iii) As array is variant type can empty Remove normal Hrs Array for(Column I) is then set tom zerow for this "row"
750 Let arrL(ShtCnt, 1) = "H" ' ' (iv)H '_-Give string, "" value of H for valid Holiday in Admin's help column
760 Else ' We had a Holiday but abscence before and after, we make in this case the AbsentK column ABSENT
770 Let arrAbscentK(ShtCnt, 1) = "ABSENT" '_- This is unusual "Abscent" case. If after and before the Holiday, the employee is absent, then the Holiday is "marked" ( in column K ) as ABSENT. This
780 Let ValidHoliday = True 'we need to reset to true
790 End If
800 Else ' No Holy Holiday
810 Let arrL(ShtCnt, 1) = "N" ' give string N for normal ' (iv)N '_-Give string, "" value of N for normal Day
820 End If
830 If arrTotHrs(ShtCnt, 1) = Empty And Not arrDteClr(ShtCnt, 1) = 65535 Then Let arrAbscentK(ShtCnt, 1) = "ABSENT" '_- column K absent days should be marked as ABSENT. This is normal Absent case for normal workdays when employee is abscent
840 '3e) ' from last code, is not now used to calculate totals
850 Next ShtCnt '--------------------------End Inner loop for rows-----
860 '3f) Paste out final Totals and days to current Worksheet
870 Let wsStear.Range("G34").Value = "=SUMIF(L1:L" & lr & ",""N"",J1:J" & lr & ")*24"
880 Let wsStear.Range("J34").Value = "=SUMIF(L1:L" & lr & ",""H"",J1:J" & lr & ")*24"
890 Let wsStear.Range("C34").Value = "=30-COUNTIF(K1:K" & lr & ",""ABSENT"")"
900 '3g) Normal Hrs ( Column I ) and Overtime Hrs ( Column J ) are changed ' And can paste out help column if you like
910 Let FstDtaCel.Offset(0, 9).Resize(lr, 1).Value2 = arrInOver() ' J ' The required spreadsheet cells range has its Range Object .Value2 values filled an allowed direct assignment to an array of values
920 Let FstDtaCel.Offset(0, 8).Resize(lr, 1).Value2 = arrInNorm() ' I
930 Let FstDtaCel.Offset(0, 11).Resize(lr, 1).Value2 = arrL() ' L
940 Let FstDtaCel.Offset(0, 10).Resize(lr, 1).Value2 = arrAbscentK() ' K
950 '3h) Set Booleans for
960 Next Cnt '==End main Loop==============================================
End Sub
'970 '
'980 'Rem Ref: http://www.excelfox.com/forum/showthread.php/2138-Understanding-VBA-Range-Object-Properties-and-referring-to-ranges-and-spreadsheet-cells
'990 '
'1000
Reply With Quote
Bookmarks