VBA to automatically allocate a new person to an account

[Chaz-13]

Hi all

I need help with some coding - i have attached a dummy version of my report with name changes

I have produced a spreadsheet which the main function is to automatically allocate a new account manager to an account but this cannot be the last account manager, it has to be someone different.

I have set the spreadsheet up using formulas to randomly select a person from the individual teams - this all works perfectly.

What I am having trouble with is making it recognise the last account manager so when it radomly selects a new person, it is a different person to the last account manager.

I have probably set this up in quite a long way, but it works, I am just stuck with this last bit.

I have recorded a macro as a button which says "allocate now".

What I have been trying to do is, I have set up a formlua in the end column which picks up if the new account manager is the same as the old account manager it displays "yes". I wanted to add on additional VBA to the macro, so when I press "allocate now" it will radomly allocate an aco**** manger, scroll down the last collumn and if any display "yes" it will re-calcuate this collumn.

Hope that all makes sense - any chance of some help?

 

[millz]

I've rewritten the code for the button, but I am not 100% sure if this is the result you wanted to achieve. You can replace your Button1 code with this and try. Delete data/formulas from column O, rows 8 to 50, and click on the button.

Function rand(ByVal min As Double, Optional ByVal max As Double)
    Dim r As Double
    If max = 0 Then
        max = min
        min = 0
    End If
    r = Rnd
    rand = (r * 1000000) - ((max - min) * Int((r * 1000000) / (max - min))) + min
End Function


Sub Button1_Click()
    Dim a, r As Long
    a = 8
    Randomize
    Do While Range("B" & CStr(a)) <> ""
        If Range("O" & CStr(a)) = "" Then
reassign:
            r = rand(1, Application.WorksheetFunction.CountIf(Sheets("TEAMS").Range("B:B"), Sheets("REPORT").Range("I" & CStr(a))))
            Range("O" & CStr(a)) = Range("I" & CStr(a)) & r
            Sheets("REPORT").Calculate
            If Range("P" & CStr(a)) = "yes" Then GoTo reassign
        End If
        a = a + 1
    Loop
End Sub