Auto Assign x No of Records against X No of People depending on Value of a Cell

Question

I am working on automating handling of the assignment of large set of records, dividing it equally to a the number of people based on the record name.

There is no fixed count of how many records there will be everyday and the number of people keeps on changing also from time to time hence will be updating the list of people from time to time.

The Records are in Tab Records and column A. Under the same tab, the Assigned To column is in column B. The People are in People Tab under column A.

I need a macro that will count the number of records that are marked as "xyz" and divide them by the number of people then use that number to assign each records equally and input the person's name under column B on the records tab. Then when the record is marked as "abc" no allocation should be done, hence, column B should be left as blank.

If done manually, it should look like as below.

However, I couldn't figure out how to make it skip all the abcs and assign only the xyz.

Appreciate your help on this please. Thanks in advance.

Dim a
With Sheets("People")
    a = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value
End With
With Sheets("Records")
    With .Range("a2", Range("a" & Rows.Count).End(xlUp)).Columns("b")
        If .Rows.Count <= UBound(a, 1) Then
            .Value = a
        Else
            .Resize(UBound(a, 1)).Value = a
            .Resize(UBound(a, 1)).AutoFill .Resize(.Rows.Count)
        End If
    End With
End With

End Sub

Answer 1

Supposing that every time, the 2 sheets will look exactly like the ones you provided, you can create a macro and paste the following code between i.e. "Sub Assign_names()" and "End Sub". Then run the macro (Alt+F8) and it will do the job!

' Count number of names
i = 1

While Sheet2.Cells(i, 1) <> 0

    i = i + 1

Wend
 
' Count number of xyz
j = 1
count_xyz = 0

While Sheet1.Cells(j, 1) <> 0

    If Sheet1.Cells(j, 1) = "xyz" Then
    xyz = xyz + 1
    End If
    j = j + 1

Wend

count_names = i - 2 ' Get number of names
count_xyz = xyz     ' Get number of xyz

xyz_share = Int(count_xyz / count_names) ' Get number of xyz for each name

k = 2
m = 2
cur_xyz_count = 1
cur_name = Sheet2.Cells(2, 1)

' Assign the names to xyz

While Sheet1.Cells(k, 1) <> ""

    cur_name = Sheet2.Cells(m, 1)
    
    If Sheet1.Cells(k, 1) = "xyz" Then ' Add names only to rows with a xyz
        
        cur_xyz_count = cur_xyz_count + 1

        If cur_xyz_count > xyz_share Then ' Check when to change the name
            m = m + 1
            cur_xyz_count = 1
        End If
        
        'Handle the case where count_xyz and count_names can't be divided evenly. Trick to assign remaining xyz to the last name in the list.
        If cur_name = "" Then cur_name = Sheet2.Cells(m - 1, 1)
        Sheet1.Cells(k, 2) = cur_name
                    
    End If
    
    k = k + 1
    
Wend