D
Don Guillett
Sorry....
Based on the second sample I guess I misunderstood the setup as it
appeared to me from the FIRST sample that the data sets were separated
by a row as in 1:2 4:5
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
Sorry....
Based on the second sample I guess I misunderstood the setup as it
appeared to me from the FIRST sample that the data sets were separated
by a row as in 1:2 4:5
D
Don Guillett
Sorry....
Based on the second sample I guess I misunderstood the setup as it
appeared to me from the FIRST sample that the data sets were separated
by a row as in 1:2 4:5
Gary's seems to work. This macro does the same for whatever rows and
columns for 1:2 3:4 etc
Option Explicit
Sub PlaceX()
Dim lc As Long
Dim i As Long
lc = Cells.Find("*", Cells(Rows.Count, Columns.Count) _
, , , xlByRows, xlPrevious).Column' last column
Columns(1).ClearContents
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 2
If Application.CountIf(Range(Cells(i, 2), Cells(i, lc)), ">0") Then
Cells(i, 1) = "X"
ElseIf Application.CountIf(Range(Cells(i + 1, 2), Cells(i + 1, lc)),
">0") Then
Cells(i + 1, 1) = "X"
End If
Next i
End Sub
Q
qcan
Gary's seems to work. This macro does the same for whatever rows and
columns for 1:2 3:4 etc
Option Explicit
Sub PlaceX()
Dim lc As Long
Dim i As Long
lc = Cells.Find("*", Cells(Rows.Count, Columns.Count) _
, , , xlByRows, xlPrevious).Column' last column
Columns(1).ClearContents
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 2
If Application.CountIf(Range(Cells(i, 2), Cells(i, lc)), ">0") Then
Cells(i, 1) = "X"
ElseIf Application.CountIf(Range(Cells(i + 1, 2), Cells(i + 1, lc)),
">0") Then
Cells(i + 1, 1) = "X"
End If
Next i
End Sub- Hide quoted text -
- Show quoted text -
Gary / Don,
Yes, both of your macros return an "X" in each set. However, for
whatever reason - it is always returning an "X" in the first row of
each set, dispite the fact that the "X" should be in the second row in
some cases when a number is greater than zero is first encountered.
Not sure how to upload a file here. I will email Don a small sample
spreadsheet on my data my data with both macros. Gary, what is you
email address ?
Thanks.
G
GS
Don Guillett formulated on Sunday :
Yes, I can see where you'd draw that conclusion. This is why I asked
the OP about blank rows between sets. In that context, your formula
works great!<g>
Thanks for your patient persistence...
Sorry....
Based on the second sample I guess I misunderstood the setup as it
appeared to me from the FIRST sample that the data sets were separated
by a row as in 1:2 4:5
Yes, I can see where you'd draw that conclusion. This is why I asked
the OP about blank rows between sets. In that context, your formula
works great!<g>
Thanks for your patient persistence...
G
GS
qcan wrote on 9/4/2011 :
According to my tests (and reported results), my macro ignores the 1st
row of each set if there's no find >0. Thus, there are 2 sets that put
x in the 2nd row only. I suggest you ALWAYS ClearContents between tests
so you only see results for the test being done. IOW, if the macros
don't behave EXACTLY the same then you'll see results from the previous
test if you don't ClearContents beforehand.
My email is gesansomATnetscapeDOTnet
Gary / Don,
Yes, both of your macros return an "X" in each set. However, for
whatever reason - it is always returning an "X" in the first row of
each set, dispite the fact that the "X" should be in the second row in
some cases when a number is greater than zero is first encountered.
Not sure how to upload a file here. I will email Don a small sample
spreadsheet on my data my data with both macros. Gary, what is you
email address ?
Thanks.
According to my tests (and reported results), my macro ignores the 1st
row of each set if there's no find >0. Thus, there are 2 sets that put
x in the 2nd row only. I suggest you ALWAYS ClearContents between tests
so you only see results for the test being done. IOW, if the macros
don't behave EXACTLY the same then you'll see results from the previous
test if you don't ClearContents beforehand.
My email is gesansomATnetscapeDOTnet
G
GS
GS was thinking very hard :
According to my tests of Don's macro, it does EXACTLY the same thing as
my macro. IOW, both macros ignore the 1st row of each set if there's no
find >0!
Here's a revision of my last macro that clears column 1 at the start
(as Don's does)...
Sub DenoteCellsGreaterThanZero2()
Dim r As Long, bRow1 As Boolean, bRow2 As Boolean
Columns(1).ClearContents
For r = 1 To ActiveSheet.UsedRange.Rows.Count Step 2
With Application.WorksheetFunction
bRow1 = (.CountIf(Rows(r), ">0") > 0)
bRow2 = (.CountIf(Rows(r).Offset(1), ">0") > 0)
End With 'Application.WorksheetFunction
If bRow1 Then Cells(r, 1) = "x": GoTo nextset
If bRow2 Then Cells(r, 1).Offset(1) = "x"
nextset:
Next 'r
End Sub
qcan wrote on 9/4/2011 :
According to my tests (and reported results), my macro ignores the 1st row of
each set if there's no find >0. Thus, there are 2 sets that put x in the 2nd
row only. I suggest you ALWAYS ClearContents between tests so you only see
results for the test being done. IOW, if the macros don't behave EXACTLY the
same then you'll see results from the previous test if you don't
ClearContents beforehand.
My email is gesansomATnetscapeDOTnet
According to my tests of Don's macro, it does EXACTLY the same thing as
my macro. IOW, both macros ignore the 1st row of each set if there's no
find >0!
Here's a revision of my last macro that clears column 1 at the start
(as Don's does)...
Sub DenoteCellsGreaterThanZero2()
Dim r As Long, bRow1 As Boolean, bRow2 As Boolean
Columns(1).ClearContents
For r = 1 To ActiveSheet.UsedRange.Rows.Count Step 2
With Application.WorksheetFunction
bRow1 = (.CountIf(Rows(r), ">0") > 0)
bRow2 = (.CountIf(Rows(r).Offset(1), ">0") > 0)
End With 'Application.WorksheetFunction
If bRow1 Then Cells(r, 1) = "x": GoTo nextset
If bRow2 Then Cells(r, 1).Offset(1) = "x"
nextset:
Next 'r
End Sub
G
GS
Ron,
Given the logic you detailed in your email, the bottom line is that
ColA will contain an x based on the FINAL CHECK of the last column in
each set. That precludes, then, than some sets will have x in both rows
(which you clearly stated is NOT what you want). In this case, both
macros need only be done on the last column to return the desired
results. Thus, your sample file is NOT correct as sent because it
places x in the 1st row of every set (as you stated). Using your logic
as stated (checking every cell in both rows) will result in an x being
on every row of every set because at some point checking every cell, an
x is always placed in ColA for both rows BECAUSE your logic doesn't say
to remove an x in the other row of the set being checked.
If the last column determines the result in ColA for both rows of a set
then there should only be 5 x's on your sample wks: Rows
11,14,17,20,26.
Here's the code I used...
Sub PlaceX2()
Dim vTemp As Variant, lRow As Long, lCol As Long
Dim bRow1 As Boolean, bRow2 As Boolean
lCol = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Column
Columns(1).ClearContents
For lRow = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 2
vTemp = Range(Cells(lRow, 2), Cells(lRow + 1, lCol))
bRow1 = (vTemp(1, lCol - 1) > 0)
bRow2 = (vTemp(2, lCol - 1) > 0)
If bRow1 Then Cells(lRow, 1) = "x": GoTo nextset
If bRow2 Then Cells(lRow, 1).Offset(1) = "x"
nextset:
Next 'lRow
End Sub
Given the logic you detailed in your email, the bottom line is that
ColA will contain an x based on the FINAL CHECK of the last column in
each set. That precludes, then, than some sets will have x in both rows
(which you clearly stated is NOT what you want). In this case, both
macros need only be done on the last column to return the desired
results. Thus, your sample file is NOT correct as sent because it
places x in the 1st row of every set (as you stated). Using your logic
as stated (checking every cell in both rows) will result in an x being
on every row of every set because at some point checking every cell, an
x is always placed in ColA for both rows BECAUSE your logic doesn't say
to remove an x in the other row of the set being checked.
If the last column determines the result in ColA for both rows of a set
then there should only be 5 x's on your sample wks: Rows
11,14,17,20,26.
Here's the code I used...
Sub PlaceX2()
Dim vTemp As Variant, lRow As Long, lCol As Long
Dim bRow1 As Boolean, bRow2 As Boolean
lCol = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Column
Columns(1).ClearContents
For lRow = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 2
vTemp = Range(Cells(lRow, 2), Cells(lRow + 1, lCol))
bRow1 = (vTemp(1, lCol - 1) > 0)
bRow2 = (vTemp(2, lCol - 1) > 0)
If bRow1 Then Cells(lRow, 1) = "x": GoTo nextset
If bRow2 Then Cells(lRow, 1).Offset(1) = "x"
nextset:
Next 'lRow
End Sub
D
Don Guillett
qcan wrote on 9/4/2011 :
According to my tests (and reported results), my macro ignores the 1st
row of each set if there's no find >0. Thus, there are 2 sets that put
x in the 2nd row only. I suggest you ALWAYS ClearContents between tests
so you only see results for the test being done. IOW, if the macros
don't behave EXACTLY the same then you'll see results from the previous
test if you don't ClearContents beforehand.
My email is gesansomATnetscapeDOTnet
--
Garry
Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc
OK. I think I may finally understand what is needed.
Option Explicit
Sub findgreaterzeroinblock()
Dim lr As Long
Dim i As Long
Dim j As Long
Dim lc As Long
Application.ScreenUpdating = False
Columns(1).ClearContents
lr = Cells(Rows.Count, 2).End(xlUp).Row
lc = Cells.Find("*", Cells(Rows.Count, _
Columns.Count), , , xlByRows, xlPrevious).Column
For i = 1 To lr Step 2
For j = 2 To lc
If Cells(i, j) > 0 Then
Cells(i, 1) = "1"
Exit For
ElseIf Cells(i + 1, j) > 0 Then
Cells(i + 1, 1) = "2"
Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
G
GS
Don,
What I find interesting is the different interpretations we derive from
reading the same email.
Your solution is correct so long as Ron wants to abort checking any
further once the first >0 is found. Although he does not state this,
I'm reconsidering that you may indeed have correctly understood the
task at hand, whereas I'm out in left field somewhere on this!
What I find interesting is the different interpretations we derive from
reading the same email.
Your solution is correct so long as Ron wants to abort checking any
further once the first >0 is found. Although he does not state this,
I'm reconsidering that you may indeed have correctly understood the
task at hand, whereas I'm out in left field somewhere on this!
Q
qcan
Don,
What I find interesting is the different interpretations we derive from
reading the same email.
Your solution is correct so long as Ron wants to abort checking any
further once the first >0 is found. Although he does not state this,
I'm reconsidering that you may indeed have correctly understood the
task at hand, whereas I'm out in left field somewhere on this!
--
Garry
Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc
Hi Garry,
Yes, Don indeed nailed it. Yes, I wanted to abort checking any further
once the first > 0 was found and yes, I am guilty of not mentioning
this as I assumed (incorrectly?) that it was not important.
THANKS again Gary for all your effort... and again THANK you Don !
G
GS
To follow Don's understanding of your task...
Sub PlaceX3()
Dim vTemp As Variant
Dim lRow As Long, lCol As Long, j As Long
lCol = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Column
Columns(1).ClearContents
For lRow = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 2
vTemp = Range(Cells(lRow, 2), Cells(lRow + 1, lCol))
For j = 1 To lCol - 1
If vTemp(1, j) > 0 Then
Cells(lRow, 1) = "X": GoTo nextset
ElseIf vTemp(2, j) > 0 Then
Cells(lRow, 1).Offset(1) = "X": GoTo nextset
End If
Next 'j
nextset:
Next 'lRow
End Sub
Sub PlaceX3()
Dim vTemp As Variant
Dim lRow As Long, lCol As Long, j As Long
lCol = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Column
Columns(1).ClearContents
For lRow = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 2
vTemp = Range(Cells(lRow, 2), Cells(lRow + 1, lCol))
For j = 1 To lCol - 1
If vTemp(1, j) > 0 Then
Cells(lRow, 1) = "X": GoTo nextset
ElseIf vTemp(2, j) > 0 Then
Cells(lRow, 1).Offset(1) = "X": GoTo nextset
End If
Next 'j
nextset:
Next 'lRow
End Sub
G
GS
After serious thinking qcan wrote :
Thanks, Don, for confirming that! See my outer posts for my version of
Don's understanding.
Best wishes...
Hi Garry,
Yes, Don indeed nailed it. Yes, I wanted to abort checking any further
once the first > 0 was found and yes, I am guilty of not mentioning
this as I assumed (incorrectly?) that it was not important.
THANKS again Gary for all your effort... and again THANK you Don !
Thanks, Don, for confirming that! See my outer posts for my version of
Don's understanding.
Best wishes...
D
Don Guillett
qcan wrote on 9/4/2011 :
According to my tests (and reported results), my macro ignores the 1st
row of each set if there's no find >0. Thus, there are 2 sets that put
x in the 2nd row only. I suggest you ALWAYS ClearContents between tests
so you only see results for the test being done. IOW, if the macros
don't behave EXACTLY the same then you'll see results from the previous
test if you don't ClearContents beforehand.
My email is gesansomATnetscapeDOTnet
--
Garry
Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc
Thought I posted this. OP tells me it worked as desired.
Option Explicit
Sub findgreaterzeroinblock()
Dim lr As Long
Dim i As Long
Dim j As Long
Dim lc As Long
Application.ScreenUpdating = False
Columns(1).ClearContents
lr = Cells(Rows.Count, 2).End(xlUp).Row
lc = Cells.Find("*", Cells(Rows.Count, _
Columns.Count), , , xlByRows, xlPrevious).Column
For i = 1 To lr Step 2
For j = 2 To lc
If Cells(i, j) > 0 Then
Cells(i, 1) = "1"
Exit For
ElseIf Cells(i + 1, j) > 0 Then
Cells(i + 1, 1) = "2"
Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
G
GS
Yes, Don, I got that and tested it. See my outer posts for my version
of your understanding of the task.
Your macro as I tested it...
Sub findgreaterzeroinblock()
Dim lr As Long, i As Long, j As Long, lc As Long
Application.ScreenUpdating = False
Columns(1).ClearContents
lr = Cells(Rows.Count, 2).End(xlUp).Row
lc = Cells.Find("*", Cells(Rows.Count, _
Columns.Count), , , xlByRows, xlPrevious).Column
For i = 1 To lr Step 2
For j = 2 To lc
If Cells(i, j) > 0 Then
Cells(i, 1) = "1": Exit For
ElseIf Cells(i + 1, j) > 0 Then
Cells(i + 1, 1) = "2": Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Works great!
of your understanding of the task.
Your macro as I tested it...
Sub findgreaterzeroinblock()
Dim lr As Long, i As Long, j As Long, lc As Long
Application.ScreenUpdating = False
Columns(1).ClearContents
lr = Cells(Rows.Count, 2).End(xlUp).Row
lc = Cells.Find("*", Cells(Rows.Count, _
Columns.Count), , , xlByRows, xlPrevious).Column
For i = 1 To lr Step 2
For j = 2 To lc
If Cells(i, j) > 0 Then
Cells(i, 1) = "1": Exit For
ElseIf Cells(i + 1, j) > 0 Then
Cells(i + 1, 1) = "2": Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Works great!
G
GS
Ron,
In my previous example, it doesn't work very fast if processing
thousands of rows because while it reads the entire set in one step, it
writes the output range each iteration of the inner loop that finds >0.
To speed the process up I revised the macro to read/write the ranges in
one step each so the entire process is done in memory before writing
back to the wks, as follows:
Sub FindFirstCellGreaterThanZero2()
' Finds the 1st cell that contains >0 in a set of row pairs
Dim vTemp As Variant, vResults() As String
Dim lRow As Long, lCol As Long, j As Long, r As Long
lCol = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Column
lRow = Cells(Rows.Count, 2).End(xlUp).Row
ReDim vResults(0, lRow)
Columns(1).ClearContents
Application.ScreenUpdating = False
For r = 1 To lRow Step 2
vTemp = Range(Cells(r, 2), Cells(r + 1, lCol))
For j = 1 To lCol - 1
If vTemp(1, j) > 0 Then
vResults(0, r - 1) = "X": GoTo nextset
ElseIf vTemp(2, j) > 0 Then
vResults(0, r) = "X": GoTo nextset
End If
Next 'j
nextset:
Next 'r
Range("A1").Resize(lRow, 1) = _
Application.WorksheetFunction.Transpose(vResults)
Application.ScreenUpdating = True
End Sub
Also, I added the following ConditionalFormatting concept (by Chip
Pearson) to shade every other pair of rows 'light green'.
Select the range to be evaluated (in this case "A1:AE30")
Add CF formula: =MOD(ROW()-Rw,N*2)+1<=N
Set the desired color for row shading
The above formula starts shading in 'odd' sets (ie: 1st,3rd,...).
If you want the shaded sets to start 'even' (ie: 2nd,4th,...), use the
following formula instead.
=MOD(ROW()-Rw,N*2)+1>N
Note that in the above formulas you need to replace the placeholders Rw
and N with your values as follows:
Rw: The 1st row number to begin shading.
N: The number of consecutive rows to shade.
In my previous example, it doesn't work very fast if processing
thousands of rows because while it reads the entire set in one step, it
writes the output range each iteration of the inner loop that finds >0.
To speed the process up I revised the macro to read/write the ranges in
one step each so the entire process is done in memory before writing
back to the wks, as follows:
Sub FindFirstCellGreaterThanZero2()
' Finds the 1st cell that contains >0 in a set of row pairs
Dim vTemp As Variant, vResults() As String
Dim lRow As Long, lCol As Long, j As Long, r As Long
lCol = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Column
lRow = Cells(Rows.Count, 2).End(xlUp).Row
ReDim vResults(0, lRow)
Columns(1).ClearContents
Application.ScreenUpdating = False
For r = 1 To lRow Step 2
vTemp = Range(Cells(r, 2), Cells(r + 1, lCol))
For j = 1 To lCol - 1
If vTemp(1, j) > 0 Then
vResults(0, r - 1) = "X": GoTo nextset
ElseIf vTemp(2, j) > 0 Then
vResults(0, r) = "X": GoTo nextset
End If
Next 'j
nextset:
Next 'r
Range("A1").Resize(lRow, 1) = _
Application.WorksheetFunction.Transpose(vResults)
Application.ScreenUpdating = True
End Sub
Also, I added the following ConditionalFormatting concept (by Chip
Pearson) to shade every other pair of rows 'light green'.
Select the range to be evaluated (in this case "A1:AE30")
Add CF formula: =MOD(ROW()-Rw,N*2)+1<=N
Set the desired color for row shading
The above formula starts shading in 'odd' sets (ie: 1st,3rd,...).
If you want the shaded sets to start 'even' (ie: 2nd,4th,...), use the
following formula instead.
=MOD(ROW()-Rw,N*2)+1>N
Note that in the above formulas you need to replace the placeholders Rw
and N with your values as follows:
Rw: The 1st row number to begin shading.
N: The number of consecutive rows to shade.