Count rows until empty cell

Deverti

Board Regular
Joined
Sep 5, 2020
Messages
63
Office Version
  1. 365
Platform
  1. Windows
i defined an area to be selected below my case if the cell below my case is not empty,
but the selected area reaches too far

how do i count the number of rows until it reaches an empty cell below my case?

VBA Code:
Sub DefineArea()
Dim vL As Range, vE As Range
    For Each vL In Range("A1", Range("A" & Rows.Count).End(xlUp))
        Select Case vL.Value
            Case "Total Ertrag"
                If Not IsEmpty(vL.Offset(1).Value) Then
                    'vL.Offset(1).Range("A1:A$" & Range("A1").End(xlDown).Row).EntireRow.Select ?
                End If
        End Select
    Next vL
End Sub
 

Some videos you may like

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

LazyBug

Board Regular
Joined
Feb 28, 2020
Messages
147
Office Version
  1. 2010
Platform
  1. Windows
VBA Code:
Dim r As Long, lR As Long
lR = Range("A1").End(xlDown).Row
For r = 1 To lR
    {YOUR CODE}
Next r
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
616
Office Version
  1. 2010
Platform
  1. Windows
Hello Mr. Deverti, try this:
VBA Code:
Sub Montecarlo_2012()

         Dim r As Range
         Dim CurrRow As Long
         Dim LastRow As Long
         
                  With Sheets("sheet1")
                  
                              CurrRow = ActiveCell.Row
                              LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                              
                                             For Each r In .Range("A" & CurrRow & ":A" & LastRow)
                                             
                                                               If r.Value <> vbNullString Then r.Offset(0, 2) = r
                                             
                                             Next r
                  
                  End With


End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,777
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub DefineArea()
Dim vL As Range, vE As Range
    For Each vL In Range("A1", Range("A" & Rows.Count).End(xlUp))
        Select Case vL.Value
            Case "Total Ertrag"
                If Not IsEmpty(vL.Offset(1).Value) Then
                    MsgBox Range(vL, vL.End(xlDown)).Count
                End If
        End Select
    Next vL
End Sub
 

Deverti

Board Regular
Joined
Sep 5, 2020
Messages
63
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Does exactly what i hoped for, thank you ☺

VBA Code:
Sub DefineAreaFluff()
Dim vL As Range, vE As Range
    For Each vL In Range("A1", Range("A" & Rows.Count).End(xlUp))
        Select Case vL.Value
            Case "Total Aufwand", "Total Ertrag"
                If Not IsEmpty(vL.Offset(1).Value) Then
                    Range(vL.Offset(1), vL.End(xlDown)).EntireRow.Cut
                    vL.Offset(-1).Insert
                End If
        End Select
    Next vL
End Sub
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
616
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Hello, many choices you have, like this one
VBA Code:
Sub montecarlo()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")

    Dim k As Long
g = Cells(Rows.Count, "A").End(xlUp).Row
    k = sh.Range("A1", sh.Range("A1").End(xlDown)).Rows.Count
    If k = 1048576 Then
        k = 1
    End If
   

MsgBox "there are:" & vbNewLine _
   & " _ " & k & "blank cells" & vbNewLine _
   & " _ " & g & "total cells in use"
End Sub
 

Deverti

Board Regular
Joined
Sep 5, 2020
Messages
63
Office Version
  1. 365
Platform
  1. Windows
Really appreciate all additional responses but my goal here simply was to move the defined areas above the selected cases and since im still rather unfamiliar with VBA as yet im content to stick with Fluffs suggestion, building on what i already came to know for the time being.
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
616
Office Version
  1. 2010
Platform
  1. Windows
All additional responses =(" LazyBug: montecarlo2012"),
thank you for your feedback. I feel this forum like a family, we are team players.
1599831126546.png
 

Watch MrExcel Video

Forum statistics

Threads
1,122,265
Messages
5,595,181
Members
413,974
Latest member
LB_

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
Top