Results 1 to 2 of 2

Thread: VBA to automatically allocate a new person to an account

  1. #1

    VBA to automatically allocate a new person to an account



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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?
    Attached Files Attached Files

  2. #2
    Acolyte millz's Avatar
    Join Date
    Aug 2013
    Location
    Singapore
    Posts
    32
    Articles
    0
    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.

    Code:
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •