Running Total SUM Based on Criteria

[prasadk]

I Have Applied This Below VBA to Do Running Total Based on Criteria it's didn't working

Here my Data looks like this to Running Total Based on Criteria

------------------------------

Col-A Col-B Col-C
Day1 Anup 150
Day2 Anup 350
Day3 Anup 240
Day4 Anup 425
Day5 Anup 125

------------------------------

I want to do Running Total Based on Criteria From Another Cells Like this below

-------------------

Col-E Col-F

-------------------

If i enter (Day2 in Column E2) Then i want to get Running Total in (Column F2) like 150+350 500
And If i enter (Day4 in Column E2) Again Then i want to get Total in (Column F2) 1165
Again if i enter (Day1 in Col-E2) Then i want to get in (Col-F2) 150







Private Sub Worksheet_Change(ByVal Target As Range)


Application.EnableEvents = False


Dim inputCell As Range, totalCell As Range, dataRng As Range
Dim addnewVal As Double
Dim lastRow As Long


Set inputCell = Range("E2")
Set totalCell = Range("F2")
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set dataRng = Range("A2:C" & lastRow)


If Not Intersect(Target, inputCell) Is Nothing Then
If inputCell = "" Then
totalCell.Value = ""
Else
With Application
If IsError(.VLookup(inputCell, dataRng, 1, False)) Then
MsgBox "Invalid Item Entered"
Else
addnewVal = .IfError(.VLookup(inputCell, dataRng, 1, False), 0)
totalCell.Value = totalCell.Value + addnewVal
End If
End With
End If


End If
Application.EnableEvents = True
End Sub

[arnelgp]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, varValue As Variant, trgValue As Variant
Dim offst As Long, sm As Double
If (Intersect(Target, Range("E:E")) Is Nothing) = False Then
trgValue = Target.Value2 & ""
Set rng = Range("A1")
varValue = rng.Offset(offst).Value2 & ""
Do While Len(varValue) <> 0
If UCase(varValue) > UCase(trgValue) Then
Exit Do
End If
sm = sm + Val(rng.Offset(offst, 2).Value2 & "")
offst = offst + 1
varValue = rng.Offset(offst).Value2
Loop
Target.Offset(, 1) = sm
End If
End Sub

[prasadk]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, varValue As Variant, trgValue As Variant
Dim offst As Long, sm As Double
If (Intersect(Target, Range("E:E")) Is Nothing) = False Then
trgValue = Target.Value2 & ""
Set rng = Range("A1")
varValue = rng.Offset(offst).Value2 & ""
Do While Len(varValue) <> 0
If UCase(varValue) > UCase(trgValue) Then
Exit Do
End If
sm = sm + Val(rng.Offset(offst, 2).Value2 & "")
offst = offst + 1
varValue = rng.Offset(offst).Value2
Loop
Target.Offset(, 1) = sm
End If
End Sub


Thank you so much arnelgp
it's working now it's my mistake