vba count cells moving up/down to specified value

gtd526

gtd526

Well-known Member
Joined
Jul 30, 2013
Messages
657
Office Version
  1. 2019
Platform
  1. Windows
Hello,
Using VBA, how can I count cells from the Blank Cell(E14) to the last cell <70% moving Up (E9) or Down, depending where the Blank cell is located. The Blank Cell is where the count will start.
The Blank cell could be in different rows (there will only be 1 blank cell in the range (between beginning and end of range).
The range of cells will always begin with E3, but may End in random cells in the same column (either E10, or E25, or E30, or E53, ????).

-5 should be the answer.
I want to use this result as an offset for # of rows to move/insert the blank cell to just below 70%'s (or other specified %).
thank you.

NBA.xlsm
E
1>=70%
2Criteria2 Percentage
375.7%
475.0%
575.0%
675.0%
772.7%
875.0%
966.7%
1066.7%
1165.0%
1265.0%
1361.4%
14
1557.1%
1655.7%
17
18
19
Sheet2
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Like this?

VBA Code: 
Sub Test()
  Dim oSet As Long, r As Long
  
  r = Range("E2").End(xlDown).Row
  Do Until Range("E" & r).Value >= 0.7 Or r = 2
    oSet = oSet - 1
    r = r - 1
  Loop
  MsgBox "Offset = " & oSet
End Sub
 
Upvote 0
Peter_SSs said:
Like this?

VBA Code: 
Sub Test()
  Dim oSet As Long, r As Long
 
  r = Range("E2").End(xlDown).Row
  Do Until Range("E" & r).Value >= 0.7 Or r = 2
    oSet = oSet - 1
    r = r - 1
  Loop
  MsgBox "Offset = " & oSet
End Sub
Click to expand...
Thank you for the reply.
The answer is -2.
I changed the 0.7 to .75 and .65 to see if there's a difference. But the answer comes back the same (-2).
 
Upvote 0
Peter_SSs said:
Like this?

VBA Code: 
Sub Test()
  Dim oSet As Long, r As Long
 
  r = Range("E2").End(xlDown).Row
  Do Until Range("E" & r).Value >= 0.7 Or r = 2
    oSet = oSet - 1
    r = r - 1
  Loop
  MsgBox "Offset = " & oSet
End Sub
Click to expand...
FYI-
Formulas are used in E:E, including the 'blank' cells. I only pasted special values in the first post. Sorry, my bad.

NBA.xlsm
E
1>=70%
2Criteria2 Percentage
377.8%
474.4%
570.0%
670.0%
770.0%
869.2%
966.7%
10 
1165.9%
1264.3%
1362.2%
41 
42 
43 
Indicators
Cell Formulas
RangeFormula
E41:E43,E3:E13E3=IF($D3="Navy",Favs!$M$43,IF($D3="MOV2, MOV > ATS",Favs!$M$55,IF($D3="Purple - Q,S,W",Favs!$V$43,IF($D3="Green - Q,S",Favs!$P$43,IF($D3="Aqua - L,Q,S",Favs!$S$43,IF($D3="Orange - Q,S,V,X,AA",Favs!$Y$43,IF($D3="K,L,Q,R>0,S>0,T>0,AB",Favs!$AB$43,IF($D3="Rank2, AL & AM >60%",Favs!$AH$43,IF($D3="MOV, AL:AM >= 60%",Favs!$AB$67,IF($D3="MOV2, AL:AM >= 60%",Favs!$AE$67,IF($D3="MOV,MOV2,AL:AM >= 60%",Favs!$AH$67,IF($D3="K,L,Q,R>0,S>0,T>0",Favs!$P$67,IF($D3="K,L,Q,R>0,X",Favs!$M$67,IF($D3="K,L,Q,R>0,S>0,T>0,AC",Favs!$AB$43,IF($D3="K,L,Q,R>0,X,AC",Favs!$S$55,IF($D3="M,N>0,Q,R>0,AL:AM > 60%",Favs!$Y$79,IF($D3="Q>=60%, S>=6",Favs!$S$67,IF($D3="Q, R, S, T>0, W",Favs!$M$79,IF($D3="EPR (AH)",Favs!$M$91,IF($D3="MOV2 > ATS",Favs!$P$55,IF($D3="Adj OFF & DEF (AH, AI)",Favs!$P$91,IF($D3="Asst/Tover >=1.85",Favs!$S$79,IF($D3="Poss/G (AD)",Favs!$S$91,IF($D3="K, R>0, T>0",Favs!$V$79,IF($D3="Tovers (AE)",Favs!$V$91,IF($D3="Steals (AF)",Favs!$Y$91,IF($D3="Rank2, AL >= 60%",Favs!$AB$55,IF($D3="Fouls (AG)",Favs!$AB$91,IF($D3="Cover2% > 60%",Favs!$AE$43,IF($D3="Rank2, AM >= 60%",Favs!$AE$55,IF($D3="Adj Off. (AI)",Favs!$AE$91,IF($D3="AC, AL & AM>= 60%",Favs!$AH$55,IF($D3="Adj Def. (AJ)",Favs!$AH$91,IF($D3="Pts in Paint (U:U)",Favs!$V$55,IF($D3="MOV2, AL:AM>= 60%",Favs!$M$103,IF($D3="M,N>0,Q,R>0,AL:AM > 60%",Favs!$Y$79,IF($D3="Pts in Paint (AJ)",Favs!$V$55,IF($D3="Q, R, S, AL:AM>=60%",Favs!$P$103,IF($D3="Cov%2,ATS+/-,AL:AM>=60%",Favs!$S$103,IF($D3="Cov%2,ATS+/-,AL:AM>=60%",Favs!$S$103,IF($D3="ATS+/-,Mov2,AL:AM>=60%",Favs!$V$103,IF($D3="Cov2%,Mov2,AL:AM>=60%",Favs!$Y$103,IF($D3="Poss/G (AL)",Favs!$S$91,IF($D3="Tovers (AM)",Favs!$V$91,IF($D3="Adj Off. (AQ)",Favs!$AE$91,IF($D3="Adj Def. (AR)",Favs!$AH$91,""))))))))))))))))))))))))))))))))))))))))))))))
 
Upvote 0
gtd526 said:
Formulas are used in E:E, including the 'blank' cells.
Click to expand...
That does make all the difference, since a cell containing "" is not blank. ;)

Try this instead. If the first 'blank' cell might be thousands of rows down, I would take a different (longer but faster) approach but if it will always be less than say 1000 rows this should be plenty fast enough.

VBA Code: 
Sub Test_v2()
  Dim oSet As Long, r As Long
  
  r = 3
  Do Until Range("E" & r).Value = ""
    oSet = (1 - oSet) * (Range("E" & r).Value < 0.7)
    r = r + 1
  Loop
  MsgBox "Offset = " & oSet
End Sub
 
Upvote 0
Solution
Peter_SSs said:
That does make all the difference, since a cell containing "" is not blank. ;)

Try this instead. If the first 'blank' cell might be thousands of rows down, I would take a different (longer but faster) approach but if it will always be less than say 1000 rows this should be plenty fast enough.

VBA Code: 
Sub Test_v2()
  Dim oSet As Long, r As Long
 
  r = 3
  Do Until Range("E" & r).Value = ""
    oSet = (1 - oSet) * (Range("E" & r).Value < 0.7)
    r = r + 1
  Loop
  MsgBox "Offset = " & oSet
End Sub
Click to expand...
Thank you for the reply.
Its works fine when were moving UP (-2), but moving down results in "0" as the value.
I've tried as <.6 and its resulted in 0.
The percentages change daily and the following is what I tested it on.
The Range will always be less than 1000 rows, yes it's fast enough.

NBA.xlsm
E
1>=70%
2Criteria2 Percentage
377.8%
474.4%
570.0%
670.0%
770.0%
8 
969.2%
1066.7%
1165.9%
1264.3%
1852.9%
1952.8%
2052.2%
2151.6%
3146.4%
3246.4%
3346.4%
3446.4%
3843.3%
3935.7%
4035.7%
41 
42 
43 
44 
Indicators
Cell Formulas
RangeFormula
E38:E44,E31:E34,E18:E21,E3:E12E3=IF($D3="Navy",Favs!$M$43,IF($D3="MOV2, MOV > ATS",Favs!$M$55,IF($D3="Purple - Q,S,W",Favs!$V$43,IF($D3="Green - Q,S",Favs!$P$43,IF($D3="Aqua - L,Q,S",Favs!$S$43,IF($D3="Orange - Q,S,V,X,AA",Favs!$Y$43,IF($D3="K,L,Q,R>0,S>0,T>0,AB",Favs!$AB$43,IF($D3="Rank2, AL & AM >60%",Favs!$AH$43,IF($D3="MOV, AL:AM >= 60%",Favs!$AB$67,IF($D3="MOV2, AL:AM >= 60%",Favs!$AE$67,IF($D3="MOV,MOV2,AL:AM >= 60%",Favs!$AH$67,IF($D3="K,L,Q,R>0,S>0,T>0",Favs!$P$67,IF($D3="K,L,Q,R>0,X",Favs!$M$67,IF($D3="K,L,Q,R>0,S>0,T>0,AC",Favs!$AB$43,IF($D3="K,L,Q,R>0,X,AC",Favs!$S$55,IF($D3="M,N>0,Q,R>0,AL:AM > 60%",Favs!$Y$79,IF($D3="Q>=60%, S>=6",Favs!$S$67,IF($D3="Q, R, S, T>0, W",Favs!$M$79,IF($D3="EPR (AH)",Favs!$M$91,IF($D3="MOV2 > ATS",Favs!$P$55,IF($D3="Adj OFF & DEF (AH, AI)",Favs!$P$91,IF($D3="Asst/Tover >=1.85",Favs!$S$79,IF($D3="Poss/G (AD)",Favs!$S$91,IF($D3="K, R>0, T>0",Favs!$V$79,IF($D3="Tovers (AE)",Favs!$V$91,IF($D3="Steals (AF)",Favs!$Y$91,IF($D3="Rank2, AL >= 60%",Favs!$AB$55,IF($D3="Fouls (AG)",Favs!$AB$91,IF($D3="Cover2% > 60%",Favs!$AE$43,IF($D3="Rank2, AM >= 60%",Favs!$AE$55,IF($D3="Adj Off. (AI)",Favs!$AE$91,IF($D3="AC, AL & AM>= 60%",Favs!$AH$55,IF($D3="Adj Def. (AJ)",Favs!$AH$91,IF($D3="Pts in Paint (U:U)",Favs!$V$55,IF($D3="MOV2, AL:AM>= 60%",Favs!$M$103,IF($D3="M,N>0,Q,R>0,AL:AM > 60%",Favs!$Y$79,IF($D3="Pts in Paint (AJ)",Favs!$V$55,IF($D3="Q, R, S, AL:AM>=60%",Favs!$P$103,IF($D3="Cov%2,ATS+/-,AL:AM>=60%",Favs!$S$103,IF($D3="Cov%2,ATS+/-,AL:AM>=60%",Favs!$S$103,IF($D3="ATS+/-,Mov2,AL:AM>=60%",Favs!$V$103,IF($D3="Cov2%,Mov2,AL:AM>=60%",Favs!$Y$103,IF($D3="Poss/G (AL)",Favs!$S$91,IF($D3="Tovers (AM)",Favs!$V$91,IF($D3="Adj Off. (AQ)",Favs!$AE$91,IF($D3="Adj Def. (AR)",Favs!$AH$91,""))))))))))))))))))))))))))))))))))))))))))))))
 
Upvote 0
gtd526 said:
, but moving down results in "0" as the value.
Click to expand...
Yes, I hadn't really tried for down until we had up working. See if this does it.

VBA Code: 
Sub Test_v3()
  Dim oSetUp As Long, oSetDown As Long, r As Long
  
  r = 3
  Do Until Range("E" & r).Value = ""
    oSetUp = (1 - oSetUp) * (Range("E" & r).Value < 0.7)
    r = r + 1
  Loop
  r = r + 1
  Do Until Range("E" & r).Value = "" Or Range("E" & r).Value >= 0.7
    oSetDown = (-1 - oSetDown) * (Range("E" & r).Value < 0.7)
    r = r + 1
  Loop
  MsgBox "Offset Up = " & oSetUp & vbLf & "Offset Down = " & oSetDown
End Sub
 
Upvote 0
Peter_SSs said:
Yes, I hadn't really tried for down until we had up working. See if this does it.

VBA Code: 
Sub Test_v3()
  Dim oSetUp As Long, oSetDown As Long, r As Long
 
  r = 3
  Do Until Range("E" & r).Value = ""
    oSetUp = (1 - oSetUp) * (Range("E" & r).Value < 0.7)
    r = r + 1
  Loop
  r = r + 1
  Do Until Range("E" & r).Value = "" Or Range("E" & r).Value >= 0.7
    oSetDown = (-1 - oSetDown) * (Range("E" & r).Value < 0.7)
    r = r + 1
  Loop
  MsgBox "Offset Up = " & oSetUp & vbLf & "Offset Down = " & oSetDown
End Sub
Click to expand...
I'm sorting the range before I offset the "", this way its always moving up. So your first vba is working perfectly.
There is no need for the moving down value. Sorry for the extra work.
Thank you.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
Count a value in a cell (within a specified range) every nth cell along the row
2
Replies
17
Views
556
KRice
K
T
  • Question
Move a shape based on Cell value. If cell is less than another shape moves up, if cell is more than another cell moved down.
Replies
5
Views
82
jolivanes
jolivanes
Livin404
  • Solved
Merge a sequence of cells based on the value in a cell.
Replies
2
Views
484
Livin404
Livin404
S
  • Solved
Macro to filter each column for cells that appear empty, clear the contents and move to the next column for entire table
Replies
3
Views
137
sspatriots
S
U
  • Question
Seeking Help with CELLS Property in VBA
2
Replies
13
Views
252
Alex Blakenburg
A

Forum statistics

Threads
1,215,069
Messages
6,122,959
Members
449,096
Latest member
Anshu121

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top