Count rows until empty cell

[Deverti]

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?

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

 

[LazyBug]

Dim r As Long, lR As Long
lR = Range("A1").End(xlDown).Row
For r = 1 To lR
    {YOUR CODE}
Next r

 

[montecarlo2012]

Hello Mr. Deverti, try this:

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]

How about

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]

Does exactly what i hoped for, thank you ☺

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

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[montecarlo2012]

Hello, many choices you have, like this one

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]

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]

All additional responses =(" LazyBug: montecarlo2012"),
thank you for your feedback. I feel this forum like a family, we are team players.