Vba for making a calculation based on condition

[Vishaal]

Hi,

we have a large data where we want to get some result, we have formula but want to convert it to in vba

Our Steps are
1. First time we are checking the value in T column if we have got the value then second step
2. We have got the value in T8, now we have put the formula

=IF(G13="","",IF(G13>=T8,G13-T8,""))

in O13 and in P13 =IF(G13="","",IF(G13>=U8,G13-U8,""))
3. We want to repeat the task, we are changing the value of T column in every Friday, you can check the formula which we have used, but we have used it manually and now want to do it through vba

Note if there is no value in D column then it will not add formula

PF the demo data

vba database.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	Head1	Head2	Head3	Head4	Head5	Head6	Head7	Head8	Head9	Head10	Head11	Head12	Head13	Head14	Head15	Head16	Head17	Head18
2	Monday	Gas	E	02-Nov-20	220.5	221.4	226.6	216.1	219.95	219.4	220.42	4461172	42232
3	Tuesday	Gas	E	03-Nov-20	219.35	221	228.45	220.05	223.5	223	223.36	3414339	31141
4	Wednesday	Gas	E	04-Nov-20	222.95	226.95	233	212	230.05	231.4	225.74	7919096	68506
5	Thursday	Gas	E	05-Nov-20	231.35	234	236.65	227.6	235.5	235.5	233.41	2425581	24493
6
7	Friday	Gas	E	06-Nov-20	235.45	235.1	242.7	233.05	239.05	239.9	238.59	2417397	29433
8	Monday	Gas	E	09-Nov-20	239.85	243	247.3	237	238.3	238.8	241.75	2145913	27056						opening stock	247.3	248
9	Tuesday	Gas	E	10-Nov-20	238.8	240	240.4	231.25	237	236.7	235.04	2520564	20746						Closing stock	231.25	231
10	Wednesday	Gas	E	11-Nov-20	236.7	234.1	238.7	231.4	233.2	234.2	234.68	1172270	19377
11	Thursday	Gas	E	12-Nov-20	234.15	235	242.65	233.25	241.45	240.6	239.03	2035182	18424
12
13	Friday	Gas	E	13-Nov-20	240.55	241.45	245	238.05	242.5	243.1	242.23	1379152	15327
14	Monday	Gas	E																opening stock	350.75	351
15	Tuesday	Gas	E	17-Nov-20	244.7	246.25	293.6	242.55	293.6	292.3	277.03	15144641	155633		46.3	45.6			Closing stock	238.05	238
16	Wednesday	Gas	E	18-Nov-20	292.3	302.45	350.75	301	339.9	345.1	333.47	26647168	331972		103.45	102.75
17	Thursday	Gas	E	19-Nov-20	345.1	340.35	346.8	312.15	331.4	331.7	333.8	9487325	125398		99.5	98.8
18
19	Friday	Gas	E	20-Nov-20	331.7	333.9	361.5	325.2	343.6	345.3	348.06	11803783	131308		10.75	10.5
20	Monday	Gas	E	23-Nov-20	345.25	358	365.75	340.95	342	344.7	349.07	4884218	64166		15	14.75			opening stock	365.75	366
21	Tuesday	Gas	E	24-Nov-20	344.65	348.8	350.95	337.5	338.5	338.8	342.26	2207876	34721		0.2				Closing stock	311.95	311
22	Wednesday	Gas	E	25-Nov-20	338.75	341.6	341.6	320	325.15	324.9	326.31	3548873	53879
23	Thursday	Gas	E	26-Nov-20	324.9	323.5	324.25	311.95	315.8	316.4	316.37	2636543	40577
Sheet1

Cell Formulas
Range	Formula
T8,T20,T14	T8	=MAX(G7:G11)
U8,U20,U14	U8	=ROUNDUP(T8,0)
T9,T21,T15	T9	=MIN(H7:H11)
U9,U21,U15	U9	=ROUNDDOWN(T9,0)
O13,O19	O13	=IF(G13="","",IF(G13>=T8,G13-T8,""))
P13,P19	P13	=IF(G13="","",IF(G13>=U8,G13-U8,""))
Q13,Q19	Q13	=IF(G13="","",IF(H13<=T9,H13-T9,""))
R13,R19	R13	=IF(G13="","",IF(H13<=U9,H13-U9,""))
O15,O21	O15	=IF(G15="","",IF(G15>=T8,G15-T8,""))
P15,P21	P15	=IF(G15="","",IF(G15>=U8,G15-U8,""))
Q15,Q21	Q15	=IF(G15="","",IF(H15<=T9,H15-T9,""))
R15,R21	R15	=IF(G15="","",IF(H15<=U9,H15-U9,""))
O16,O22	O16	=IF(G16="","",IF(G16>=T8,G16-T8,""))
P16,P22	P16	=IF(G16="","",IF(G16>=U8,G16-U8,""))
Q16,Q22	Q16	=IF(G16="","",IF(H16<=T9,H16-T9,""))
R16,R22	R16	=IF(G16="","",IF(H16<=U9,H16-U9,""))
O17,O23	O17	=IF(G17="","",IF(G17>=T8,G17-T8,""))
P17,P23	P17	=IF(G17="","",IF(G17>=U8,G17-U8,""))
Q17,Q23	Q17	=IF(G17="","",IF(H17<=T9,H17-T9,""))
R17,R23	R17	=IF(G17="","",IF(H17<=U9,H17-U9,""))
O20	O20	=IF(G20="","",IF(G20>=T14,G20-T14,""))
P20	P20	=IF(G20="","",IF(G20>=U14,G20-U14,""))
Q20	Q20	=IF(G20="","",IF(H20<=T15,H20-T15,""))
R20	R20	=IF(G20="","",IF(H20<=U15,H20-U15,""))

guide me how can we do that

 

[maabadi]

Try this:

Sub ReplaceFormulas()
Dim WS As Worksheet, i As Long, j As Long, Lr As Long, k As Long
Lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 3
k = 6 * i + 2
If k < Lr Then
Range("T" & k).Value = Application.WorksheetFunction.Max(Range("G" & k - 1 & ":G" & k + 3))
Range("U" & k).Value = Application.WorksheetFunction.RoundUp(Range("T" & k), 0)
Range("T" & k + 1).Value = Application.WorksheetFunction.Min(Range("H" & k - 1 & ":H" & k + 3))
Range("U" & k + 1).Value = Application.WorksheetFunction.RoundDown(Range("T" & k + 1), 0)
Else
Exit Sub
End If
Next i

For i = 13 To Lr
For j = 15 To 18
k = (Int((i - 5) / 7)) * 6 + 2
If j <= 16 Then
If Cells(i, 7).Value = "" Then
Cells(i, j).Value = ""
ElseIf Cells(i, 7).Value >= Cells(k, j + 5).Value Then
Cells(i, j).Value = Cells(i, 7).Value - Cells(k, j + 5).Value
Else
Cells(i, j).Value = ""
End If
Else
If Cells(i, 7).Value = "" Then
Cells(i, j).Value = ""
ElseIf Cells(i, 7).Value <= Cells(k + 1, j + 3).Value Then
Cells(i, j).Value = Cells(i, 7).Value - Cells(k + 1, j + 3).Value
Else
Cells(i, j).Value = ""
End If
End If
Next j
Next i
End Sub

 

[Vishaal]

Thanks

maabadi ji​

you have saved my lots of time

thank you very much

 

[maabadi]

You're Welcome & Thanks for feedback.