Search code examples
excelvba

Allocate parts equally

Sheet1 has one column "Part".
Sheet2 contains one column "Analyst".

I want to allocate the parts equally to the Analysts.

Suppose my Part column contain 5 parts and 3 Analysts are present today.

Sheet1
Sheet1

Sheet2
Sheet2

Parts and its count
Parts and its count

Expected output-1
my expected output

Expected output sorted column Parts-2
enter image description here

Allocation count should look like:
enter image description here

Expected output sorted column Parts.

The below macro allocated all the part numbers to one analyst.

Sub AssignAnalysts()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim partRange As Range, analystRange As Range
    Dim i As Long, j As Long
    Dim analystIndex As Long

    ' Set references to the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")

    ' Find the last rows with data in each sheet
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    ' Set ranges for Part and Analyst columns
    Set partRange = ws1.Range("A2:A" & lastRow1)
    Set analystRange = ws2.Range("A2:A" & lastRow2)

    ' Initialize analystIndex
    analystIndex = 1

    ' Loop through each row in the Part column
    For i = 1 To partRange.Rows.Count
        ' Get the current part
        part = partRange.Cells(i, 1).Value

        ' Loop through analysts and assign them to parts
        For j = 1 To analystRange.Rows.Count
            ' Get the current analyst
            analyst = analystRange.Cells(j, 1).Value

            ' Assign analyst to the part and increment analystIndex
            ws1.Cells(i + (j - 1) * lastRow1, 3).Value = analyst
        Next j
    Next i
End Sub
Solution

  • The inner/second for loop means the last analyst will always be assigned to every part. This for loop is not needed. I think this can be simplified to:

    ' Loop through each row in the Part column
    j = 1                          ' point to the first analyst
    For i = 2 To lastRow1          ' scroll through ws1 (parts)
        ' Get the analyst
        analyst = analystRange.Cells(j, 1).Value  
        ' Assign the analyst to the part
        ws1.Cells(i, 2).value = analyst
        ' point to next analyst. If end of list, cycle to top.
        j = j + 1
        if j > analystRange.Rows.Count then
            j = 1
        end if
    Next i