vba count cells moving up/down to specified value

gtd526

gtd526

Well-known Member
Joined
Jul 30, 2013
Messages
696
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

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
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

E
  • Solved
Disable Autocomplete VBA in a cell range
Replies
4
Views
116
Peter_SSs
Peter_SSs
F
  • Solved
VBA to move range if cell value is not empty
Replies
5
Views
89
fotodj
F
D
  • Question Question
VBA Search a range for a value, then copy and paste data only from source to defined cells.
Replies
0
Views
102
Davion615
D
N
  • Question Question
Count a value in a cell (within a specified range) every nth cell along the row
2
Replies
17
Views
2K
KRice
K
T
  • Question 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
449
jolivanes
jolivanes

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

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