Hi. I have a table in which I assign team members to specific tasks using the vlookup. I would like to each team member should have 20 requests assigned. The rest of requests should receive the status "unassigned". What's the easiest way to do this?
Sub myFunction()
Dim uniqueNames() As String
Dim j As Integer
j = 1
Dim lRow As Integer
'Get unique names to an array
ReDim Preserve uniqueNames(1, 0)
uniqueNames(0, 0) = Cells(1, 1).Value
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lRow
If Not Cells(i, 1).Value = uniqueNames(0, j - 1) Then
ReDim Preserve uniqueNames(1, j)
uniqueNames(0, j) = Cells(i, 1).Value
j = j + 1
End If
Next
j = j - 1
'Set name counter to 0
For i = 0 To j
uniqueNames(1, i) = 0
Next
'Detect if appeared more than 20
For i = 0 To j
For ii = 1 To lRow
If uniqueNames(0, i) = Cells(ii, 1).Value Then
uniqueNames(1, i) = uniqueNames(1, i) + 1
If uniqueNames(1, i) > 20 Then
Cells(ii, 1).Value = "unassigned"
End If
End If
Next
Next
End Sub
Sub myFunction()
Dim j As Integer
Dim lRow As Integer
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lRow
If Not Cells(i, 1).Value = "unassigned" Then
j = 0
For ii = i + 1 To lRow
If Cells(i, 1).Value = Cells(ii, 1).Value Then
j = j + 1
If j >= 20 Then
Cells(ii, 1).Value = "unassigned"
End If
End If
Next
End If
Next
End Sub
If Cells(i, 1).Value = Cells(ii, 1).Value Then
Sub myFunction()
Dim j As Integer
Dim lRow As Integer
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lRow
If Not Application.IsNA(Cells(i, 1).Value) Then
If Not Cells(i, 1).Value = "unassigned" Then
j = 0
For ii = i + 1 To lRow
If Not Application.IsNA(Cells(ii, 1).Value) Then
If Cells(i, 1).Value = Cells(ii, 1).Value Then
j = j + 1
If j >= 20 Then
Cells(ii, 1).Value = "unassigned"
End If
End If
End If
Next
End If
End If
Next
End Sub