Limited scope VLookup

[Demirion]

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?

 

[Demirion]

Corrected it. I even copied some code from the formula that worked earlier and nothing. Unfortunately, that's not the case :/

 

[Demirion]

I will try to explain it better. I used vlookup to assign employees to certain tasks but it doesn't matter. The point is, let's say in column A I have 300 different names. I would like to do so that if there are more than 20 of a specific name, e.g. Smith, in column A, then unassigned is displayed instead. So let's assume that column A to row 55 has 20 Smith surnames and from row 55 it should already show unassigned. Maybe a loop and a conditional statement will be the easiest way to do it?

 

[Demirion]

For example, I did it manually with a smaller number. If a name appears more than 3 times, unassigned is displayed. The end result should be like this:

 

[Legacy 143009]

I think I nailed it

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

 

[Demirion]

Thanks, it works. Difficult code. It can be done in a simpler way without the use of an array?

 

[Legacy 143009]

Maybe Something like this?

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

 

[Demirion]

Thanks, but there's one more problem. In the example file it works, but in another file I have the required variables and I don't know why but I get "type mismatch" with this code:

If Cells(i, 1).Value = Cells(ii, 1).Value Then

I have tried different variables but nothing helps.

 

[Legacy 143009]

Maybe you have dates or numbers.. I cannot say anything without seeing the actual data...

 

[Demirion]

Sorry for the confusion. I already know what's wrong. I have "# N / A" in the column. Could this be solved in some simple way? I think it's best to skip such cells.

 

[Legacy 143009]

So a simple check will solve the problem:

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