Please add one condition on this VBA script

ganu learner · Jan 11, 2020

All dear friends please update my script with one another condition. Script is at the bottom of page.
According to script
if Cells(currow, "B") > Cells(currow + 1, "B") Then
col = "E"
ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
col = "F"
Else
col = "G"
WorksheetFunction.Sum(Range("G5:G" & currow))

Now I want to add one another condition on it.
if Cells(currow, "B") = Cells(currow + 1, "B")
I explain with example

Suppose B10=B9
Then B10 compare with previous cells B8,B7..... more till then it's valve is higher or lower with B cells.
Suppose B6. (B10<B6). is higher then the value of C9 is add with sum of F4 and sum of match condition shown in B4.
Suppose B6 (B10>B6) Is lower then the value of C9 is add with sum of E4 and sum of match condition shown in C4.

VBA Code:

Private Sub Worksheet_Calculate()
Dim capturerow As Long, currow As Long, col As String
On Error GoTo handerror

Application.EnableEvents = False
capturerow = 2
currow = Range("A65536").End(xlUp).Row
If currow < 5 Then currow = 5

Cells(currow + 1, 1) = Cells(capturerow, 1)
Cells(currow + 1, 2) = Cells(capturerow, 2)
Cells(currow + 1, 3) = Cells(capturerow, 3)
Cells(currow + 1, 4) = Cells(capturerow, 4)
If currow > 5 Then
If Cells(currow, "B") > Cells(currow + 1, "B") Then
col = "E"
ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
col = "F"
Else
col = "G"
End If
Cells(currow, col) = Cells(currow + 1, "C") - Cells(currow, "C")
End If
Range("E4").Value = WorksheetFunction.Sum(Range("E5:E" & currow))
Range("F4").Value = WorksheetFunction.Sum(Range("F5:F" & currow))
Range("G4").Value = WorksheetFunction.Sum(Range("G5:G" & currow))
handerror:
Application.EnableEvents = True
End Sub

juddaaaa · Jan 11, 2020

Just add another ElseIf

VBA Code:

If Cells(currow, "B") > Cells(currow + 1, "B") Then
     col = "E"
ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
     col = "F"
ElseIf Cells(currow, "B") = Cells(currow + 1, "B") Then
     '// DO SOMETHING ELSE HERE
Else
     col = "G"
End If

Also, consider indenting your code. It makes it more readable

VBA Code:

Private Sub Worksheet_Calculate()

    Dim capturerow As Long, currow As Long, col As String
    On Error GoTo handerror
  
    Application.EnableEvents = False
    capturerow = 2
    currow = Range("A65536").End(xlUp).Row
  
    If currow < 5 Then currow = 5
  
    Cells(currow + 1, 1) = Cells(capturerow, 1)
    Cells(currow + 1, 2) = Cells(capturerow, 2)
    Cells(currow + 1, 3) = Cells(capturerow, 3)
    Cells(currow + 1, 4) = Cells(capturerow, 4)
  
    If currow > 5 Then
        If Cells(currow, "B") > Cells(currow + 1, "B") Then
            col = "E"
        ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
            col = "F"
        ElseIf Cells(currow, "B") = Cells(currow + 1, "B") Then
            '// DO SOMETHING ELSE HERE
        Else
            col = "G"
        End If
      
        Cells(currow, col) = Cells(currow + 1, "C") - Cells(currow, "C")
    End If
  
    Range("E4").Value = WorksheetFunction.Sum(Range("E5:E" & currow))
    Range("F4").Value = WorksheetFunction.Sum(Range("F5:F" & currow))
    Range("G4").Value = WorksheetFunction.Sum(Range("G5:G" & currow))
  
handerror:
    Application.EnableEvents = True
End Sub

ganu learner · Jan 11, 2020

juddaaaa said:

Just add another ElseIf

VBA Code:

If Cells(currow, "B") > Cells(currow + 1, "B") Then
     col = "E"
ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
     col = "F"
ElseIf Cells(currow, "B") = Cells(currow + 1, "B") Then
     '// DO SOMETHING ELSE HERE
Else
     col = "G"
End If

Also, consider indenting your code. It makes it more readable

VBA Code:

Private Sub Worksheet_Calculate()

    Dim capturerow As Long, currow As Long, col As String
    On Error GoTo handerror
 
    Application.EnableEvents = False
    capturerow = 2
    currow = Range("A65536").End(xlUp).Row
 
    If currow < 5 Then currow = 5
 
    Cells(currow + 1, 1) = Cells(capturerow, 1)
    Cells(currow + 1, 2) = Cells(capturerow, 2)
    Cells(currow + 1, 3) = Cells(capturerow, 3)
    Cells(currow + 1, 4) = Cells(capturerow, 4)
 
    If currow > 5 Then
        If Cells(currow, "B") > Cells(currow + 1, "B") Then
            col = "E"
        ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
            col = "F"
        ElseIf Cells(currow, "B") = Cells(currow + 1, "B") Then
            '// DO SOMETHING ELSE HERE
        Else
            col = "G"
        End If
     
        Cells(currow, col) = Cells(currow + 1, "C") - Cells(currow, "C")
    End If
 
    Range("E4").Value = WorksheetFunction.Sum(Range("E5:E" & currow))
    Range("F4").Value = WorksheetFunction.Sum(Range("F5:F" & currow))
    Range("G4").Value = WorksheetFunction.Sum(Range("G5:G" & currow))
 
handerror:
    Application.EnableEvents = True
End Sub

Res Sir, thanks for helping me
Sir above script modified by you in not working in below condition.
Sir my task is not completed without solve this condition. I do not know about vba programming. So please help me on this

I again try to explain my condition
I got some data from row 2 and now two or more B cells are equal in anywhere.

Cells(currow, "B") = Cells(currow + 1, "B") Then

now I want suppose B10=B9 then check B10 with B8....
which previous B cell is higher or lower with B10 then value of Cells(currow, col) = Cells(currow + 1, "C") - Cells(currow, "C")
in the sum of new condition.
now if B10> then value of C is add with the sum of E4 cell.
now if B10< then value of C is add with the sum of F4 cell.

ganu learner · Jan 14, 2020

Res all friends please help me about below script according to script if
If Cells(currow, "B") > Cells(currow + 1, "B") Then
col = "E"
ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
col = "F"
Else
col = "G"
now i want to some change which data is going on col="G"
i want if Cells(currow, "B") < Cells(currow + 1, "B") Then
current cell compare with its previous cell till then its is higher or lower with current cell
If current cell is
Cells(currow, "B") > Cells(currow + 1, "B") Then
col = "F"
if lower
If Cells(currow, "B") < Cells(currow + 1, "B") Then
col = "F "

pleaseeeeeee

Private Sub Worksheet_Calculate()
Dim capturerow As Long, currow As Long, col As String
On Error GoTo handerror

Application.EnableEvents = False
capturerow = 2
currow = Range("A65536").End(xlUp).Row
If currow < 5 Then currow = 5

Cells(currow + 1, 1) = Cells(capturerow, 1)
Cells(currow + 1, 2) = Cells(capturerow, 2)
Cells(currow + 1, 3) = Cells(capturerow, 3)
Cells(currow + 1, 4) = Cells(capturerow, 4)
If currow > 5 Then
If Cells(currow, "B") > Cells(currow + 1, "B") Then
col = "E"
ElseIf Cells(currow, "B") < Cells(currow + 1, "B") Then
col = "F"
Else
col = "G"
End If
Cells(currow, col) = Cells(currow + 1, "C") - Cells(currow, "C")
End If
Range("E4").Value = WorksheetFunction.Sum(Range("E5:E" & currow))
Range("F4").Value = WorksheetFunction.Sum(Range("F5:F" & currow))
Range("G4").Value = WorksheetFunction.Sum(Range("G5:G" & currow))
handerror:
Application.EnableEvents = True
End Sub

Book1

A

B

C

D

E

F

G

6

RELIANCE-EQ

1542.05

1160831

14-Jan-20 10:03:51 AM

0

7

RELIANCE-EQ

1542.05

1160831

14-Jan-20 10:03:51 AM

1031

8

RELIANCE-EQ

1542.3

1161862

14-Jan-20 10:03:56 AM

257

9

RELIANCE-EQ

1542.3

1162119

14-Jan-20 10:03:57 AM

277

10

RELIANCE-EQ

1542.35

1162396

14-Jan-20 10:03:59 AM

76

11

RELIANCE-EQ

1542.4

1162472

14-Jan-20 10:04:02 AM

79

12

RELIANCE-EQ

1542.35

1162551

14-Jan-20 10:04:02 AM

80

13

RELIANCE-EQ

1542.35

1162631

14-Jan-20 10:04:06 AM

0

14

RELIANCE-EQ

1542.4

1162631

14-Jan-20 10:04:06 AM

221

15

RELIANCE-EQ

1542.4

1162852

14-Jan-20 10:04:09 AM

48

16

RELIANCE-EQ

1542.35

1162900

14-Jan-20 10:04:11 AM

528

17

RELIANCE-EQ

1542.35

1163428

14-Jan-20 10:04:13 AM

1187

18

RELIANCE-EQ

1541.75

1164615

14-Jan-20 10:04:15 AM

12

19

RELIANCE-EQ

1541.8

1164627

14-Jan-20 10:04:16 AM

1207

20

RELIANCE-EQ

1541.8

1165834

14-Jan-20 10:04:19 AM

34

21

RELIANCE-EQ

1541.8

1165868

14-Jan-20 10:04:21 AM

238

22

RELIANCE-EQ

1541.75

1166106

14-Jan-20 10:04:24 AM

175

23

RELIANCE-EQ

1541.8

1166281

14-Jan-20 10:04:26 AM

34

24

RELIANCE-EQ

1542

1166315

14-Jan-20 10:04:27 AM

239

25

RELIANCE-EQ

1542

1166554

14-Jan-20 10:04:29 AM

9

26

RELIANCE-EQ

1542

1166563

14-Jan-20 10:04:30 AM

25

27

RELIANCE-EQ

1542

1166588

14-Jan-20 10:04:33 AM

121

28

RELIANCE-EQ

1541.95

1166709

14-Jan-20 10:04:36 AM

235

29

RELIANCE-EQ

1541.95

1166944

14-Jan-20 10:04:38 AM

338

30

RELIANCE-EQ

1541.9

1167282

14-Jan-20 10:04:40 AM

1690

31

RELIANCE-EQ

1541.9

1168972

14-Jan-20 10:04:42 AM

1017

32

RELIANCE-EQ

1541.8

1169989

14-Jan-20 10:04:44 AM

29

33

RELIANCE-EQ

1541.75

1170018

14-Jan-20 10:04:45 AM

438

34

RELIANCE-EQ

1541.9

1170456

14-Jan-20 10:04:48 AM

0

35

RELIANCE-EQ

1541.9

1170456

14-Jan-20 10:04:48 AM

250

36

RELIANCE-EQ

1541.8

1170706

14-Jan-20 10:04:52 AM

6443

37

RELIANCE-EQ

1542.5

1177149

14-Jan-20 10:04:53 AM

349

38

RELIANCE-EQ

1542.25

1177498

14-Jan-20 10:04:56 AM

234

39

RELIANCE-EQ

1542.5

1177732

14-Jan-20 10:04:57 AM

445

40

RELIANCE-EQ

1542.55

1178177

14-Jan-20 10:05:00 AM

164

41

RELIANCE-EQ

1542.5

1178341

14-Jan-20 10:05:02 AM

32

42

RELIANCE-EQ

1542.45

1178373

14-Jan-20 10:05:04 AM

363

43

RELIANCE-EQ

1542.5

1178736

14-Jan-20 10:05:06 AM

300

44

RELIANCE-EQ

1542.45

1179036

14-Jan-20 10:05:08 AM

373

45

RELIANCE-EQ

1542.45

1179409

14-Jan-20 10:05:10 AM

303

46

RELIANCE-EQ

1542.45

1179712

14-Jan-20 10:05:12 AM

141

47

RELIANCE-EQ

1542.5

1179853

14-Jan-20 10:05:13 AM

19

48

RELIANCE-EQ

1542.5

1179872

14-Jan-20 10:05:16 AM

80

49

RELIANCE-EQ

1542.5

1179952

14-Jan-20 10:05:17 AM

187

50

RELIANCE-EQ

1542.45

1180139

14-Jan-20 10:05:19 AM

674

51

RELIANCE-EQ

1542.45

1180813

14-Jan-20 10:05:22 AM

0

52

RELIANCE-EQ

1542.45

1180813

14-Jan-20 10:05:22 AM

273

reliance MW

Please add one condition on this VBA script

ganu learner

New Member

Excel Facts

juddaaaa

Board Regular

ganu learner

New Member

ganu learner

New Member

Similar threads

Forum statistics

Share this page

Please add one condition on this VBA script

ganu learner

New Member

Excel Facts

juddaaaa

Board Regular

ganu learner

New Member

ganu learner

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock