Trouble flagging conditions in Excel using VB

J

Juventus Ventuno

I am trying to flag records where a condition is met and am getting 'almost' answers. There is a column with - and + values. The code will iterate until sum = 2000 OR (sum>=2000 and next record is positive) - so the last consecutive negative record that >= 2000 will get flagged. Code below does not wait until the end of the last negative number (i.e, 30 records in a row with - number). Any thoughts on fixing?

Dim homecell As Range
Set homecell = Range("I1")


Set homecell = Range("A1").EntireRow.Find("2k Flag")
homecell.Select
homecell.EntireColumn.ClearContents
homecell = "2k Flag"

Dim i As Long
i = 1
Dim a As Long
a = 0
Dim pos As Boolean
Dim sum As Double
Dim sfrom As Double
sfrom = 1
i = 1
Dim wforp As Boolean

Do Until sfrom > Range("A1").End(xlDown).Row

If Range("A1").Offset(sfrom, 0) = Range("A1").Offset(sfrom + a, 0) Then

Do Until a = 2000 Or (sum <= -200 And pos = False) Or pos = True
sum = sum + homecell.Offset(sfrom + a, -1)
If homecell.Offset(sfrom + a, -1) > 0 Then
pos = True
wforp = False
End If

a = a + 1
Loop

If pos = False And sum <= -200 And wforp = False Then
homecell.Offset(sfrom + a - 1, 0) = "yes"
wforp = True
sfrom = sfrom + a - 1

End If

sum = 0
pos = False
a = 0

Else
wforp = False

End If

sfrom = sfrom + 1
Loop
 
C

Claus Busch

Hi Juventus,

Am Wed, 22 Oct 2014 16:51:35 -0700 (PDT) schrieb Juventus Ventuno:
I am trying to flag records where a condition is met and am getting 'almost' answers. There is a column with - and + values. The code will iterate until sum = 2000 OR (sum>=2000 and next record is positive) - so the last consecutive negative record that >= 2000 will get flagged. Code below does not wait until the end of the last negative number (i.e, 30 records in a row with - number). Any thoughts on fixing?

if in column A sum >= 2000 and cell is negative then you get "yes" in
column B:

Sub Test()
Dim varCheck As Variant
Dim i As Long, n As Long
Dim LRow As Long, Pos As Long
Dim mySum As Double

With ActiveSheet
On Error Resume Next
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:B" & LRow).ClearContents
varCheck = .Range("A1:A" & LRow)
For i = 1 To LRow
n = 1
mySum = 0
Do
mySum = mySum + varCheck(i + n, 1)
n = n + 1
Loop Until mySum >= 2000 And varCheck(i + n, 1) < 0
.Cells(i + n, 2) = "yes"
i = i + n
Next
End With
End Sub


Regards
Claus B.
 
C

Claus Busch

Hi Juventus,

Am Thu, 23 Oct 2014 10:18:42 +0200 schrieb Claus Busch:
if in column A sum >= 2000 and cell is negative then you get "yes" in
column B:

better try:

Sub Test()
Dim varCheck As Variant
Dim i As Long, n As Long
Dim LRow As Long, Pos As Long
Dim mySum As Double

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:B" & LRow).ClearContents
varCheck = .Range("A1:A" & LRow)
For i = 1 To LRow
n = 1
mySum = 0
Do
mySum = mySum + varCheck(i + n, 1)
n = n + 1
If mySum < 2000 And n + i > UBound(varCheck) Then Exit Sub
Loop Until mySum >= 2000 And varCheck(i + n, 1) < 0
.Cells(i + n, 2) = "yes"
i = i + n
Next
End With
End Sub


Regards
Claus B.
 
D

dguillett

I am trying to flag records where a condition is met and am getting 'almost' answers. There is a column with - and + values. The code will iterate until sum = 2000 OR (sum>=2000 and next record is positive) - so the last consecutive negative record that >= 2000 will get flagged. Code below does not wait until the end of the last negative number (i.e, 30 records in a row with - number). Any thoughts on fixing?

Dim homecell As Range
Set homecell = Range("I1")


Set homecell = Range("A1").EntireRow.Find("2k Flag")
homecell.Select
homecell.EntireColumn.ClearContents
homecell = "2k Flag"

Dim i As Long
i = 1
Dim a As Long
a = 0
Dim pos As Boolean
Dim sum As Double
Dim sfrom As Double
sfrom = 1
i = 1
Dim wforp As Boolean

Do Until sfrom > Range("A1").End(xlDown).Row

If Range("A1").Offset(sfrom, 0) = Range("A1").Offset(sfrom + a, 0) Then

Do Until a = 2000 Or (sum <= -200 And pos = False) Or pos = True
sum = sum + homecell.Offset(sfrom + a, -1)
If homecell.Offset(sfrom + a, -1) > 0 Then
pos = True
wforp = False
End If

a = a + 1
Loop

If pos = False And sum <= -200 And wforp = False Then
homecell.Offset(sfrom + a - 1, 0) = "yes"
wforp = True
sfrom = sfrom + a - 1

End If

sum = 0
pos = False
a = 0

Else
wforp = False

End If

sfrom = sfrom + 1
Loop

I'm not sure about the last negative number and next positive number without seeing a couple of examples (EXPLAIN) but this will sum until the sum is >= 2000 and next number is >=0.
'========
Option Explicit

Sub sumto()
Dim mc As String
Dim lr As Long
Dim i As Long
Dim ms As Long

mc = "A"
lr = Cells(Rows.Count, mc).End(xlUp).Row
ms = 0
For i = 1 To lr
ms = ms + Cells(i, mc)
If ms >= 2000 And Cells(i + 1) >= 0 Then
MsgBox ms
Exit For
End If
Next i
End Sub
 
J

Juventus Ventuno

Hi Juventus,

Am Thu, 23 Oct 2014 10:18:42 +0200 schrieb Claus Busch:


better try:

Sub Test()
Dim varCheck As Variant
Dim i As Long, n As Long
Dim LRow As Long, Pos As Long
Dim mySum As Double

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:B" & LRow).ClearContents
varCheck = .Range("A1:A" & LRow)
For i = 1 To LRow
n = 1
mySum = 0
Do
mySum = mySum + varCheck(i + n, 1)
n = n + 1
If mySum < 2000 And n + i > UBound(varCheck) Then Exit Sub
Loop Until mySum >= 2000 And varCheck(i + n, 1) < 0
.Cells(i + n, 2) = "yes"
i = i + n
Next
End With
End Sub


Regards
Claus B.

thank you. here is a sample of the dataset. the script does iterate thru a dataset with unique sub-sets, called by field 'pipeline ID', so the analysis does not bleed over from one pipeline ID to another.

https://dl.dropboxusercontent.com/u/35610819/test.xlsx
 
J

Juventus Ventuno

I'm not sure about the last negative number and next positive number without seeing a couple of examples (EXPLAIN) but this will sum until the sum is >= 2000 and next number is >=0.
'========
Option Explicit

Sub sumto()
Dim mc As String
Dim lr As Long
Dim i As Long
Dim ms As Long

mc = "A"
lr = Cells(Rows.Count, mc).End(xlUp).Row
ms = 0
For i = 1 To lr
ms = ms + Cells(i, mc)
If ms >= 2000 And Cells(i + 1) >= 0 Then
MsgBox ms
Exit For
End If
Next i
End Sub

thank you. here is a sample of the dataset. the script does iterate thru a dataset with unique sub-sets, called by field 'pipeline ID', so the analysis does not bleed over from one pipeline ID to another.

https://dl.dropboxusercontent.com/u/35610819/test.xlsx
 
D

dguillett

I am trying to flag records where a condition is met and am getting 'almost' answers. There is a column with - and + values. The code will iterate until sum = 2000 OR (sum>=2000 and next record is positive) - so the last consecutive negative record that >= 2000 will get flagged. Code below does not wait until the end of the last negative number (i.e, 30 records in a row with - number). Any thoughts on fixing?

Dim homecell As Range
Set homecell = Range("I1")


Set homecell = Range("A1").EntireRow.Find("2k Flag")
homecell.Select
homecell.EntireColumn.ClearContents
homecell = "2k Flag"

Dim i As Long
i = 1
Dim a As Long
a = 0
Dim pos As Boolean
Dim sum As Double
Dim sfrom As Double
sfrom = 1
i = 1
Dim wforp As Boolean

Do Until sfrom > Range("A1").End(xlDown).Row

If Range("A1").Offset(sfrom, 0) = Range("A1").Offset(sfrom + a, 0) Then

Do Until a = 2000 Or (sum <= -200 And pos = False) Or pos = True
sum = sum + homecell.Offset(sfrom + a, -1)
If homecell.Offset(sfrom + a, -1) > 0 Then
pos = True
wforp = False
End If

a = a + 1
Loop

If pos = False And sum <= -200 And wforp = False Then
homecell.Offset(sfrom + a - 1, 0) = "yes"
wforp = True
sfrom = sfrom + a - 1

End If

sum = 0
pos = False
a = 0

Else
wforp = False

End If

sfrom = sfrom + 1
Loop
You still have not told us what you want and why and you send an xlsX file with no macros (auto stripped out when saved as xlsX). And you don't tell us which column to use and what the answer should be and why.????????
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top