Macro to Continue Loop untill empty cell

Maybe this:

Option Explicit

Private Sub CommandButton1_Click()

Dim x As Integer
Dim y As Integer
Dim lLR As Long

With Worksheets("Tracker")
    lLR = .Range("I" & .Rows.Count).End(xlUp).Row
End With

y = 3

For x = 1 To lLR
    If Worksheets("People_List").Cells(x, 2) = "In" Then
        Worksheets("Tracker").Range(Cells(y, 11), Cells(y, 11)).Value = _
            Worksheets("People_List").Range(Cells(x, 1), Cells(x, 1)).Value
        y = y + 11
    End If
Next x

End Sub

Regards, TMS

Can you post a sample workbook. I've got nothing to test your code, or my code, with and I have no idea what the worksheets or data look like.

Regards, TMS

Amended code:

Option Explicit

Private Sub CommandButton1_Click()

Dim x As Integer
Dim y As Integer
Dim lLR As Long

With Worksheets("People_List")
    lLR = .Range("A" & .Rows.Count).End(xlUp).Row
End With

y = 3

For x = 1 To lLR
    ' Debug.Print x, y, Worksheets("People_List").Cells(x, 1), Worksheets("People_List").Cells(x, 2)
    If Worksheets("People_List").Cells(x, 2) = "In" Then
        Worksheets("Tracker").Cells(y, 11).Value = _
            Worksheets("People_List").Cells(x, 1).Value
        y = y + 11
    End If
Next x

End Sub

... is there a way to add criteria that if Agent name is same, to continue with next Controller from people list?

Sorry, I don't understand what you are asking for.


Regards, TMS

Maybe:

Private Sub CommandButton1_Click()
Dim wt As Worksheet, wp As Worksheet, x As Integer, y As Integer, lLR As Long
Set wt = Worksheets("Tracker"): Set wp = Worksheets("People_List")
 
    lLR = wt.Range("I" & wt.Rows.Count).End(xlUp).Row: y = 3
For x = 1 To lLR
    If wp.Cells(x, 2) = "In" Then
Ctl:
        If wt.Cells(y, 11) = "" Then
        wt.Cells(y, 11).Value = wp.Cells(x, 1).Value
        y = y + 11: GoTo GetNext
        Else: y = y + 11: GoTo Ctl: End If: End If
GetNext: Next x: End Sub

Hi dobracik,

Thanks for the rep!

BTW - your request only makes sense if the Controllers on the People sheet are not unique - is that the case??

Try this:

Private Sub CommandButton1_Click(): Dim Agent As Object
Dim wt As Worksheet, wp As Worksheet, x As Integer, y As Integer, lLR As Long
Set wt = Worksheets("Tracker"): Set wp = Worksheets("People_List")
Set Agent = CreateObject("Scripting.Dictionary")
 
    lLR = wp.Range("A" & wp.Rows.Count).End(xlUp).Row: y = 3
For x = 1 To lLR
    If wp.Cells(x, 2) = "In" Then
        
Ctl:
        If Not Agent.Exists(Trim(wp.Cells(x, 1))) Then
        If wt.Cells(y, 11) = "" Then
        wt.Cells(y, 11).Value = wp.Cells(x, 1)
        Agent.Item(Trim(wp.Cells(x, 1))) = x
        y = y + 11: GoTo GetNext
        Else: Agent.Item(Trim(wt.Cells(y, 11))) = y
        y = y + 11: GoTo Ctl: End If: End If: End If
GetNext: Next x: End Sub

that once the Agent name is pasted to column K in "Tracker" sheet and is equal to agent name in column A "Tracker" sheet, that macro will skip this name and past the next one?

It already does this when it processes each row (x index) on the People sheet:|

Can you explain again what you need? - I'm not quite clear on what you want

Try this:

Private Sub CommandButton1_Click(): Dim Agent As Object, K 'Dictionary keys
Dim wt As Worksheet, wp As Worksheet, x As Long, y As Long, u As Long, LR As Long
Set wt = Worksheets("Tracker"): Set wp = Worksheets("People_List")
        LR = wp.Range("A" & wp.Rows.Count).End(xlUp).Row: y = 3
            Set Agent = CreateObject("Scripting.Dictionary")
For x = 1 To LR
    If wp.Cells(x, 2) = "In" Then Agent.Item(Trim(wp.Cells(x, 1))) = x
Next x: K = Agent.Keys()
        LR = wt.Range("I" & wt.Rows.Count).End(xlUp).Row
    For y = 3 To LR Step 11
    If u > UBound(K) Then Exit Sub
    If wt.Cells(y, 11) = "" Then
    For x = LBound(K) To UBound(K)
    If K(x) <> Trim(wt.Cells(y, 1)) And K(x) <> "DONE" Then
    wt.Cells(y, 11) = K(x): K(x) = "DONE": u = u + 1: Exit For: End If
    Next x
    End If: Next y
End Sub

You're welcome!

A slight improvement:

Private Sub CommandButton1_Click(): Dim Agent As Object, K 'Dictionary keys
Dim wt As Worksheet, wp As Worksheet, x As Long, y As Long, u As Long, LR As Long
Set wt = Worksheets("Tracker"): Set wp = Worksheets("People_List")
        LR = wp.Range("A" & wp.Rows.Count).End(xlUp).Row: y = 3
            Set Agent = CreateObject("Scripting.Dictionary")
For x = 1 To LR
    If wp.Cells(x, 2) = "In" Then Agent.Item(Trim(wp.Cells(x, 1))) = x
Next x: K = Agent.Keys()
        LR = wt.Range("I" & wt.Rows.Count).End(xlUp).Row
    For y = 3 To LR Step 11
    If u > UBound(K) Then Exit Sub
        If wt.Cells(y, 11) = "" Then
            For x = LBound(K) To UBound(K)
        If K(x) <> Trim(wt.Cells(y, 1)) And Agent.Item(K(x)) <> 0 Then
        wt.Cells(y, 11) = K(x): Agent.Item(K(x)) = 0: u = u + 1: Exit For: End If
            Next x
        Else: Agent.Item(Trim(wt.Cells(y, 11))) = 0
    End If: Next y
End Sub