VBA to Split value across uniques found with multiple criteria

[melkent]

Good morning,

I am not sure if the title does the question justice. If Columns A,B,D,E,F,G and H match BUT column C does not match, I need a way to split the total hours(Column H) worked each day across each unique area as the count in each area/divided by the sum of the total count by employee that day * total hours worked by that employee

Here is a sample of the data . Rows 1-4 Columns A,B,D,E,F,G and H match BUT column C does not. So I need the 4.75 in hours split across the 4 areas he worked that day. With H2 becoming the SUM(I2/Sum(I2:I5)) *H2), H3 being SUM(I3/Sum(I2:I5))*H3) etc. But H5 being left as is, because it doesnt meet the criteria. H2 would be =sum (11/Sum(11+1+12+1)*4.75)

Contract	Division	Area	Date	Employee Name	ClassCode	Region	Total Hours	amount	count
ABC	NW-11	TRM11	10/21/2023​	EMP 1	WP	SL	4.75​	165​	11​
ABC	NW-11	TRM25	10/21/2023​	EMP 1	WP	SL	4.75​	19​	1​
ABC	NW-11	TRM16	10/21/2023​	EMP 1	WP	SL	4.75​	199​	12​
ABC	NW-11	TRM13	10/21/2023​	EMP 1	WP	SL	4.75​	14​	1​
ABC	NW-11	SNR13	10/17/2023​	EMP 1	WC	SL	8.25​	687​	35​
ABC	JJ-1	RED16	10/20/2023​	EMP 3	WC	SL	10.5​	745​	35​
ABC	JJ-1	SNR11	10/20/2023​	EMP 3	WC	SL	10.5​	31​	1​
ABC	JJ-1	JOR04	10/20/2023​	EMP 3	WC	SL	10.5​	57​	5​
ABC	NW12	SNR11	10/19/2023​	EMP 1	WC	SL	10.75​	255​	9​
ABC	NW12	SNR13	10/19/2023​	EMP 1	WC	SL	10.75​	112​	7​
ABC	NW12	JOR04	10/19/2023​	EMP 1	WC	SL	10.75​	406​	19​
ABC	NW12	RED16	10/19/2023​	EMP 1	WC	SL	10.75​	118​	5​
GHI	301457	CORV151	10/18/2023​	EMP 2	WC	NC	7.5​	270​	12​
GHI	301457	CORV151	10/17/2023​	EMP 2	WC	NC	10.75​	536​	31​

So this would be the result I need when completed

Contract	Division	Area	Date	Employee Name	ClassCode	Region	Total Hours	amount	count
ABC	NW-11	TRM11	10/21/2023​	EMP 1	WP	SL	2.09​	165​	11​
ABC	NW-11	TRM25	10/21/2023​	EMP 1	WP	SL	0.19​	19​	1​
ABC	NW-11	TRM16	10/21/2023​	EMP 1	WP	SL	2.28​	199​	12​
ABC	NW-11	TRM13	10/21/2023​	EMP 1	WP	SL	0.19​	14​	1​
ABC	NW-11	SNR13	10/17/2023​	EMP 1	WC	SL	8.25​	687​	35​
ABC	JJ-1	RED16	10/20/2023​	EMP 3	WC	SL	8.96​	745​	35​
ABC	JJ-1	SNR11	10/20/2023​	EMP 3	WC	SL	0.26​	31​	1​
ABC	JJ-1	JOR04	10/20/2023​	EMP 3	WC	SL	1.28​	57​	5​
ABC	NW12	SNR11	10/19/2023​	EMP 1	WC	SL	2.42​	255​	9​
ABC	NW12	SNR13	10/19/2023​	EMP 1	WC	SL	1.88​	112​	7​
ABC	NW12	JOR04	10/19/2023​	EMP 1	WC	SL	5.11​	406​	19​
ABC	NW12	RED16	10/19/2023​	EMP 1	WC	SL	1.34​	118​	5​
GHI	301457	CORV151	10/18/2023​	EMP 2	WC	NC	7.5​	270​	12​
GHI	301457	CORV151	10/17/2023​	EMP 2	WC	NC	10.75​	536​	31​

I have tried filtering for the unique list, copying to a new sheet, having the formulas give me the split of the hours and then replacing it but this is manual. Hoping to put this in a larger vba. Any help would be appreciated on what the code should be or look like. Thank you in advance your help

 

[melkent]

I figured it out.
Sub righthours()
Dim ContractName As Range, cn As Range, DivisionName As Range, dn As Range, AreaName As Range, an As Range,WorkDate As Range, wd As Range, EmpName As Range, en As Range, Classcode as Range, cc as Range, RegionName As Range, rn As Range, Hours As Range, hr As Range, Count As Range, cnt As Range

Set ContractName= wsMasterSD.Range("A2:A" & LR6)
Set DivisionName = wsMasterSD.Range("B2:B" & LR6)
Set AreaName = wsMasterSD.Range("C2:C" & LR6)
Set Workdate = wsMasterSD.Range("D2:D" & LR6)
Set EmpName = wsMasterSD.Range("E2:E" & LR6)
Set Region = wsMasterSD.Range("G2:G" & LR6)
Set Hours = wsMasterSD.Range("H2:H" & LR6)
Set Count = wsMasterSD.Range("J2:J" & LR6)


wsMasterSD.Range("W1") = "Total Count"
wsMasterSD.Range("X1") = "Total area Hours"



For Each cc In classcode
cc.Offset(0, 17) = WorksheetFunction.SumIfs(Count, CStr(cc.Offset(0, -5)), AreaName, CStr(cc.Offset(0, -4)), WorkDate, CStr(cc.Offset(0, -2)), EmpName, CStr(cc.Offset(0, -1)), Region, CStr(cc.Offset(0, 1)))
cc.Offset(0, 18) = (cc.Offset(0, 4) / cc.Offset(0, 17)) * (cc.Offset(0, 2))
cc.Offset(0, 2) = cc.Offset(0, 18)
Next cc
Columns("W:X").Delete.EntireColumn
End Sub