Please add one condition on this VBA script

ganu learner

New Member
Joined
Dec 31, 2019
Messages
43
Office Version
  1. 2013
Platform
  1. Windows
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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

juddaaaa

Board Regular
Joined
Jan 4, 2020
Messages
208
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Dec 31, 2019
Messages
43
Office Version
  1. 2013
Platform
  1. Windows
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

New Member
Joined
Dec 31, 2019
Messages
43
Office Version
  1. 2013
Platform
  1. Windows
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
ABCDEFG
6RELIANCE-EQ1542.05116083114-Jan-20 10:03:51 AM0
7RELIANCE-EQ1542.05116083114-Jan-20 10:03:51 AM1031
8RELIANCE-EQ1542.3116186214-Jan-20 10:03:56 AM257
9RELIANCE-EQ1542.3116211914-Jan-20 10:03:57 AM277
10RELIANCE-EQ1542.35116239614-Jan-20 10:03:59 AM76
11RELIANCE-EQ1542.4116247214-Jan-20 10:04:02 AM79
12RELIANCE-EQ1542.35116255114-Jan-20 10:04:02 AM80
13RELIANCE-EQ1542.35116263114-Jan-20 10:04:06 AM0
14RELIANCE-EQ1542.4116263114-Jan-20 10:04:06 AM221
15RELIANCE-EQ1542.4116285214-Jan-20 10:04:09 AM48
16RELIANCE-EQ1542.35116290014-Jan-20 10:04:11 AM528
17RELIANCE-EQ1542.35116342814-Jan-20 10:04:13 AM1187
18RELIANCE-EQ1541.75116461514-Jan-20 10:04:15 AM12
19RELIANCE-EQ1541.8116462714-Jan-20 10:04:16 AM1207
20RELIANCE-EQ1541.8116583414-Jan-20 10:04:19 AM34
21RELIANCE-EQ1541.8116586814-Jan-20 10:04:21 AM238
22RELIANCE-EQ1541.75116610614-Jan-20 10:04:24 AM175
23RELIANCE-EQ1541.8116628114-Jan-20 10:04:26 AM34
24RELIANCE-EQ1542116631514-Jan-20 10:04:27 AM239
25RELIANCE-EQ1542116655414-Jan-20 10:04:29 AM9
26RELIANCE-EQ1542116656314-Jan-20 10:04:30 AM25
27RELIANCE-EQ1542116658814-Jan-20 10:04:33 AM121
28RELIANCE-EQ1541.95116670914-Jan-20 10:04:36 AM235
29RELIANCE-EQ1541.95116694414-Jan-20 10:04:38 AM338
30RELIANCE-EQ1541.9116728214-Jan-20 10:04:40 AM1690
31RELIANCE-EQ1541.9116897214-Jan-20 10:04:42 AM1017
32RELIANCE-EQ1541.8116998914-Jan-20 10:04:44 AM29
33RELIANCE-EQ1541.75117001814-Jan-20 10:04:45 AM438
34RELIANCE-EQ1541.9117045614-Jan-20 10:04:48 AM0
35RELIANCE-EQ1541.9117045614-Jan-20 10:04:48 AM250
36RELIANCE-EQ1541.8117070614-Jan-20 10:04:52 AM6443
37RELIANCE-EQ1542.5117714914-Jan-20 10:04:53 AM349
38RELIANCE-EQ1542.25117749814-Jan-20 10:04:56 AM234
39RELIANCE-EQ1542.5117773214-Jan-20 10:04:57 AM445
40RELIANCE-EQ1542.55117817714-Jan-20 10:05:00 AM164
41RELIANCE-EQ1542.5117834114-Jan-20 10:05:02 AM32
42RELIANCE-EQ1542.45117837314-Jan-20 10:05:04 AM363
43RELIANCE-EQ1542.5117873614-Jan-20 10:05:06 AM300
44RELIANCE-EQ1542.45117903614-Jan-20 10:05:08 AM373
45RELIANCE-EQ1542.45117940914-Jan-20 10:05:10 AM303
46RELIANCE-EQ1542.45117971214-Jan-20 10:05:12 AM141
47RELIANCE-EQ1542.5117985314-Jan-20 10:05:13 AM19
48RELIANCE-EQ1542.5117987214-Jan-20 10:05:16 AM80
49RELIANCE-EQ1542.5117995214-Jan-20 10:05:17 AM187
50RELIANCE-EQ1542.45118013914-Jan-20 10:05:19 AM674
51RELIANCE-EQ1542.45118081314-Jan-20 10:05:22 AM0
52RELIANCE-EQ1542.45118081314-Jan-20 10:05:22 AM273
reliance MW
 

Watch MrExcel Video

Forum statistics

Threads
1,118,979
Messages
5,575,347
Members
412,655
Latest member
habercio
Top