Trouble with vba 'loop' finding last row

[CaptainGravyBum]

Hello,
I have a spreadsheet which is populated by copying from an external sheet. The first column only has data in the initial row for the series so I've tried to create a macro which loops copying the data down as required and does exactly what I need except when it gets to the end of the rows and doesn't know where to stop. I'm trying to use column b to find the last row because column A doesn't always have data when it comes to the last batch of data.
Also, when I've managed to get this to work, I could use some help figuring out how to remove the rows that containing the total column as they are not required.
Thanks,

Sub Fill_Registrations()
'
' Fill registrations
'
Dim x As Integer
Application.ScreenUpdating = False
NumRows = Range("B1", Range("B1").End(xlDown)).Rows.Count
For x = 1 To NumRows
Range("A1").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Selection.End(xlDown).Select
Selection.Offset(-1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Next
Application.ScreenUpdating = True

End Sub

 

[mumps]

It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[rlv01]

    For x = 1 To NumRows
        Range("A1").Select
        Selection.End(xlDown).Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.End(xlDown).Select
        Selection.Offset(-1).Select
        Range(Selection, Selection.End(xlUp)).Select
        ActiveSheet.Paste
    Next

You have defined a loop, using x as the looping variable but then never use x inside the loop. That never ends well. If I understand what you are after, then see if this works.

Sub Fill_Registrations()
    Dim rng As Range
    Dim R As Range
    Dim S As String
    
    With ActiveSheet
        Set rng = .Range("A1:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With
    
    For Each R In rng
        Select Case Trim(R.Value)
            Case "Registration"
                S = ""
            Case Is <> ""
                S = R.Value
            Case Is = ""
                R.Value = S
        End Select
    Next R
End Sub

 

[CaptainGravyBum]

    For x = 1 To NumRows
        Range("A1").Select
        Selection.End(xlDown).Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.End(xlDown).Select
        Selection.Offset(-1).Select
        Range(Selection, Selection.End(xlUp)).Select
        ActiveSheet.Paste
    Next

You have defined a loop, using x as the looping variable but then never use x inside the loop. That never ends well. If I understand what you are after, then see if this works.

Sub Fill_Registrations()
    Dim rng As Range
    Dim R As Range
    Dim S As String
   
    With ActiveSheet
        Set rng = .Range("A1:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With
   
    For Each R In rng
        Select Case Trim(R.Value)
            Case "Registration"
                S = ""
            Case Is <> ""
                S = R.Value
            Case Is = ""
                R.Value = S
        End Select
    Next R
End Sub

Thanks @rlv01
This works a treat.

Not to push my luck, but can you suggest the best way to find rows containing "total" in column b and delete the entire row?

 

[rlv01]

Not to push my luck, but can you suggest the best way to find rows containing "total" in column b and delete the entire row?

Try this (not tested).

Sub xFill_Registrations()
    Dim rng As Range
    Dim R As Range
    Dim S As String
    Dim RowsToDelete As Range
    
    
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Columns.AutoFilter Field:=.Columns("B").Column, Criteria1:="Total*"
        With .UsedRange
            Set RowsToDelete = Application.Intersect(.SpecialCells(xlCellTypeVisible).EntireRow, .Resize(.Rows.Count - 1).Offset(1).EntireRow)
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
        If Not RowsToDelete Is Nothing Then
            RowsToDelete.EntireRow.Delete
        End If
        
        Set rng = .Range("A1:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With
    
    For Each R In rng
        Select Case Trim(R.Value)
            Case "Registration"
                S = ""
            Case Is <> ""
                S = R.Value
            Case Is = ""
                R.Value = S
        End Select
    Next R
End Sub

 

[CaptainGravyBum]

Try this (not tested).

Sub xFill_Registrations()
    Dim rng As Range
    Dim R As Range
    Dim S As String
    Dim RowsToDelete As Range
   
   
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Columns.AutoFilter Field:=.Columns("B").Column, Criteria1:="Total*"
        With .UsedRange
            Set RowsToDelete = Application.Intersect(.SpecialCells(xlCellTypeVisible).EntireRow, .Resize(.Rows.Count - 1).Offset(1).EntireRow)
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
        If Not RowsToDelete Is Nothing Then
            RowsToDelete.EntireRow.Delete
        End If
       
        Set rng = .Range("A1:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With
   
    For Each R In rng
        Select Case Trim(R.Value)
            Case "Registration"
                S = ""
            Case Is <> ""
                S = R.Value
            Case Is = ""
                R.Value = S
        End Select
    Next R
End Sub

Spot on once again!
I wish I could learn how to write vba as good as this.

Thanks @rlv01