Loop in VBA to restart formula until there is no more names in a list

[tcorcoran15]

Hello,

I have a very basic VBA code like as follows:

Sub Hello()


'Removes any duplicates
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$27").RemoveDuplicates Columns:=1, Header:=xlNo

'Copies name from top of CE List into Input tab G12
Sheets("Names").Select
Range("A1").Select
Selection.Copy
Sheets("INPUT").Select
Range("G12").Select
ActiveSheet.Paste


'Copies Update File into Export File as paste value
Sheets("UPDATE FILE").Select
Range("A1:A9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("EXPORT").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Deletes the first line

Sheets("Names").Select
Range("A1").Select
Selection.Delete Shift:=xlUp

End Sub

I have a list full of names in the 'Names' sheet and it then copies the name into the Input sheet and then paste copies the results into another tab called 'Export' at the next available blank cell. I have to keep pressing the button for each name but I would like to make it more automated so that when I press the macro button it does the step and then carries on doing it in a loop until all the names are gone? The cell either with a name in or blank will always be A1 in Names worksheet.

Thanks in advance for any help!

 

[rlv01]

You can play around with this approach (disclaimer: I did not have a chance to test it)

Sub Hello()    
   Dim R As Range, Rng As Range

    'Removes any duplicates
    ActiveSheet.Range("$A$1:$A$27").RemoveDuplicates Columns:=1, Header:=xlNo

    With Sheets("Names")
        Set Rng = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
        For Each R In Rng
            'Copies name from top of CE List into Input tab G12
            R.Copy Sheets("INPUT").Range("G12")

            'Copies Update File into Export File as paste value
            Sheets("UPDATE FILE").Range("A1:A9").Copy
            With Sheets("EXPORT")
                .Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            End With
        Next R

        'If you don't want to delete all the names, then comment out the next line
        Rng.EntireRow.Delete
    End With
End Sub

Btw, please use CODE tags when posting code to make it easier to read

 

[tcorcoran15]

Works great, thank you!