Jump to content
Sign in to follow this  
Jfish

Secret Santa Automation

Recommended Posts

Jfish

***

EDIT 11/29/14: I made a huge mistake in the original as it only created pairs (i.e. if I get you - you also get me).  What I really needed was for each person to get anyone but themselves - but not necessarily create a pair.  The issue then became that if there was one person left at the end they could not get themselves.

This new version (1.1).  Does several things:

1. It creates a unique match for everyone on the list without reciprocal pairs

2. Added: deletion of blank rows before processing

3. Added checking for the word "name" in the first cell to see if headers are included

4. Sample names file included

5. GUI slightly modified

***

 

Its that time of year again.  The holidays are upon us.  Therefore, I decided to automate the creation a "secret santa" list.   These lists are popular around the holidays but usually require at least some manual labor to pair people up.  This generator takes the work out of it.  Just feed it a list of names via an Excel spreadsheet with the names populated in the first column (no blanks or headers please).  It will then generate a new file with the pairings for each name on the list.  I even paid for a graphic with usage right that is included in the zip file along with the source and Koda GUI (modified for relative file location of the image).  Enjoy.

Just the code for those that don't want the whole file:

; Secret Santa Pairing Genertaor
; Use this application to randonmly pair people for secret Santa
; All names must be entered on first col of a spreadhsheet
; no headers - no blank rows
; JFish v 1.1
;********************************

#include<Excel.au3>
#include<Array.au3>
#include <ButtonConstants.au3>
#include <GUIConstantsEx.au3>
#include <StaticConstants.au3>
#include <WindowsConstants.au3>
#Region ### START Koda GUI section ### Form=C:\Users\Jayme\Documents\Code\secret santa\secretSnataGUI2.kxf
$Form1 = GUICreate("Secret Santa List Generator v 1.1", 533, 331, 201, 124)
GUISetBkColor(0xFFFFFF)
$Button1 = GUICtrlCreateButton("Select Excel File With Names", 144, 200, 233, 49)
GUICtrlSetFont(-1, 8, 800, 0, "MS Sans Serif")
GUICtrlSetBkColor(-1, 0xA6CAF0)
$Pic1 = GUICtrlCreatePic(@ScriptDir&"\400pxSecretSanata.bmp", 64, 8, 404, 172)
$Label1 = GUICtrlCreateLabel("Press the above button to select an Excel file containing names in Col A", 16, 264, 507, 24)
GUICtrlSetFont(-1, 12, 400, 0, "MS Sans Serif")
$Label2 = GUICtrlCreateLabel("The software will randomly produce Secret Santa pairs  and display then in a new file", 16, 293, 502, 20)
GUICtrlSetFont(-1, 10, 400, 0, "MS Sans Serif")
GUISetState(@SW_SHOW)
#EndRegion ### END Koda GUI section ###


func _createList()
; will be used to control the while loop - counts the number of pairs created
dim $pairs=0
; find a an Excel sheet containing names in Col 1
$path=FileOpenDialog("Select File With Secret Santa Names",@ScriptDir,"Excel (*.xl*)" )
    If @error Then
            ; Display the error message.
            MsgBox($MB_SYSTEMMODAL, "", "No file(s) were selected.")
    else
        ; open excel file from FileOpenDialog
        GLOBAL $excel=_Excel_Open()
        Local $oWorkbook = _Excel_BookOpen($excel, $path)
        ;delete all blank rows in Col A
        $oWorkbook.ActiveSheet.Columns("A:A").SpecialCells($xlCellTypeBlanks).EntireRow.Delete
        ; find last non blank row
        $LastRow = $oWorkbook.ActiveSheet.Range("A1").SpecialCells($xlCellTypeLastCell).Row
        ;find text in cell A1 to make sure it is not a header
        Local $aResult = _Excel_RangeRead($oWorkbook, Default, "A1")
        ;non-comprehensive data check to make sure the number of names is even for pairing and A1 does not contain header
        if mod($LastRow,2)<>0 or StringInStr($aResult,"name")<>0 then
            MsgBox("","Data Error","You need to have an even number of names and the file should not contain headers")
        else
            $namesArray = _Excel_RangeRead($oWorkbook, Default, $oWorkbook.ActiveSheet.Usedrange.Columns("A:A"))
            ; close that workbook
            _Excel_BookClose($oWorkbook)

            ; create new 2D array to store the pairings
            dim $pairingArray[ubound($namesArray)][3]

            ; populate first row of new array
            For $a=0 to UBound($pairingArray)-1
                $pairingArray[$a][0]=$namesArray[$a]
            Next

            ; this starts a loop that will run until everyone has a pairing
            while $pairs<(UBound($pairingArray)-1)

                ;this loop looks for a partner for each person on the list sequesntially
                for $names=0 to UBound($pairingArray)-1
                    ;does the name have anyone assigned to it? If not then ...
                    if $pairingArray[$names][1]=="" Then
                        ;generate random number
                        local $randomNumber=round(Random(0,ubound($pairingArray)-1),0)
                            ; creates to VARs for name on list and randomly generated name used for comparison
                            $originalName=$pairingArray[$pairs][0]
                            $randomName=$pairingArray[$randomNumber][0]
                            ;checks to ensure that if only one name is left on the list without a partner that you need
                            ;to erase everything and do it again ... this one drove me CRAZY
                            if $pairs==UBound($pairingArray)-2 AND $pairingArray[UBound($pairingArray)-1][1]=="" AND $pairingArray[UBound($pairingArray)-1][2]=="" Then
                                $pairs=0
                                for $deleteNames=0 to ubound($pairingArray)-1
                                    $pairingArray[$deleteNames][1]=""
                                    $pairingArray[$deleteNames][2]=""
                                next
                                ;ConsoleWrite(@crlf&"!!!DEBUG: NEW LOOP TRIGGEED !!!")
                                ExitLoop
                            EndIf
                            ; if the name random name is the same as the person you are matching OR the person you are
                            ; attempting to match has already been assigned then keep trying ...
                            if ($originalName==$randomName) OR ($pairingArray[$randomNumber][2]=="matched") then
                                do
                                $randomNumber=round(Random(0,ubound($pairingArray)-1),0)
                                until ($pairingArray[$pairs][0]<>$pairingArray[$randomNumber][0]) AND ($pairingArray[$randomNumber][2]<>"matched")
                            Endif
                            ; random person looks good so write it to the array
                            $pairingArray[$names][1]=$pairingArray[$randomNumber][0]
                            ; mark that person as matched so we don't pick them again
                            $pairingArray[$randomNumber][2]="matched"
                            ; increment the condition for the outer while loop
                            ; in this case keep going until we have the whole list
                            $pairs+=1
                    EndIf
                next
            WEnd
            ; paste it to a new results Excel spreadsheet
            GLOBAL $resultsWorkbook=_Excel_BookNew($excel)
            _Excel_RangeWrite($resultsWorkbook,$resultsWorkbook.Activesheet,$pairingArray,"A1")
        EndIf; this one is for the even number check
    EndIf
EndFunc


While 1
    $nMsg = GUIGetMsg()
    Switch $nMsg
        case $Button1
            _createList()
        Case $GUI_EVENT_CLOSE
            Exit

    EndSwitch
WEnd

secretsanta1.1.zip

Edited by Jfish

Build your own poker game with AutoIt: pokerlogic.au3 | Learn To Program Using FREE Tools with AutoIt

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

  • Similar Content

    • robertocm
      By robertocm
      I'm using this for replacing text strings in the VBProject of all excel files in a folder and subfolders.
      I have the same text string in several lines and those lines could have some differences between files: then not feasible for .ReplaceLine method
      I'm not interested in placing all the code in a xla AddIn, because the code is similar but not exactly the same in all the files.
       
      Opt("WinTitleMatchMode", 2) ;1=start, 2=subStr, 3=exact, 4=advanced, -1 to -4=Nocase #include <File.au3> #include <WinAPIFiles.au3> #include <Excel.au3> $oMyError = ObjEvent("AutoIt.Error", "ErrFunc") ;Install a custom error handler Global $iEventError ; to be checked to know if com error occurs. Must be reset after handling. Global Const $sMessage = "Select Folder" Global $sFileSelectFolder = FileSelectFolder($sMessage, "") If @error Then MsgBox(0, "", "No folder was selected.") Exit EndIf Global $bFileOpen ;Look for excel files in selected directory and all subdirectories Global $aFileList = _FileListToArrayRec($sFileSelectFolder, "*.xlsm", $FLTAR_FILES, $FLTAR_RECUR, $FLTAR_NOSORT, $FLTAR_FULLPATH) If Not @error Then Local $oAppl = _Excel_Open(Default, Default, False, Default, True) ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_Open" & @CRLF & "@error = " & @error & ", @extended = " & @extended) For $i = 1 To $aFileList[0] $bFileOpen = _WinAPI_FileInUse($aFileList[$i]) If $bFileOpen = 0 Then ;ShellExecute($aFileList[$i]) Local $oWorkbook = _Excel_BookOpen($oAppl, $aFileList[$i]) ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_BookOpen: " & $sFilePath & @CRLF & "@error = " & @error & ", @extended = " & @extended) Local $oProject = $oWorkbook.VBProject ;From: Adapt VBA in a workbook using VBA / http://www.snb-vba.eu/index_en.html ;2.7.2 Macromodule delete With $oProject .VBComponents.Remove(.VBComponents("SplashText")) If $iEventError Then Consolewrite("SplashText Form not found: " & $aFileList[$i] & @CRLF) $iEventError = 0 ; Reset after displaying a COM Error occurred EndIf .VBComponents.Import("C:\Documents and Settings\XP\Escritorio\PLANTILLAS_EXPORT\SplashText.frm") EndWith ;3.2.1.8 Macro: delete With $oProject.VBComponents("Actual").CodeModule ;3.2.1.2 Macro: find If .Find("Sub Check_NumPed(", 1, 1, -1, -1) Then ;Note: using '+ 1' at the end of the line because i'm used to add an empty line between procedures (see vba help for ProcCountLines) .DeleteLines( .ProcStartLine("Check_NumPed", 0), .ProcCountLines("Check_NumPed", 0) + 1) EndIf EndWith ;Check if range name exists. If not create named ranges If Not IsObj($oWorkbook.Sheets("DATOS").Evaluate("Booking_DestPort")) Then ;If Not IsObj($oWorkbook.Sheets("DATOS").Range("Booking_DestPort")) Then If $oWorkbook.Sheets("DATOS").Range("AC7").value = "DestPort" Then $oWorkbook.Names.Add("Booking_DestPort", "=DATOS!$AC$8") Else ConsoleWrite("-> Not: 'DestPort' in AC7" & @TAB & $aFileList[$i] & @CRLF) EndIf If $oWorkbook.Sheets("DATOS").Range("AD7").value = "FinalDest" Then $oWorkbook.Names.Add("Booking_FinalDest", "=DATOS!$AD$8") Else ConsoleWrite("-> Not: 'FinalDest' in AD7" & @TAB & $aFileList[$i] & @CRLF) EndIf EndIf ;Open VBE Editor (like Alt+F11) $oAppl.VBE.MainWindow.Visible = True ;$oAppl.VBE.Windows("Inmediato").Visible = True ;https://www.autoitscript.com/forum/topic/77545-resolved-vbaofficeexcel-experts/ ;Spiff59, Aug 2008 ;Local $oModules = $oProject.VBComponents ;Local $oModules = $oWorkbook.VBProject.VBComponents ;$oModules.Item(1).CodeModule.CodePane.Show ;$oModules.Item(1).Activate ; With $oModules.Item($y).CodeModule ; .ReplaceLine (1 , "Sub SpellCheck()") ; .DeleteLines (10, 1) ; .InsertLines (7 , "TEST") ; EndWith ;Wait 30 seconds for the window to appear. Local $hWnd = WinWait("Microsoft Visual Basic - ", "Proyecto - VBAProjec", 30) WinActivate($hWnd) WinWaitActive($hWnd, "", 30) If WinActive($hWnd, "") Then ;Sleep(100) ;Send("{F7}") $oProject.VBComponents("Actual").Activate ;Wait 30 seconds for the window to appear. Local $hWnd2 = WinWait(" - [Actual (Código)]", "Proyecto - VBAProject", 30) WinActivate($hWnd2) WinWaitActive($hWnd2, "", 30) ;First Replace If WinActive($hWnd2, "") Then Send("{CTRLDOWN}h{CTRLUP}") ;Wait 30 seconds for the window to appear. Local $hWnd3 = WinWait("Reemplazar", "&Procedimiento actua", 30) WinActivate($hWnd3) WinWaitActive($hWnd3, "", 30) Sleep(100) Send('Sheets("DATOS").Range("AC8")') Sleep(200) Send("{TAB}") Sleep(100) ;Send("{DEL}") Send('Range("Booking_DestPort")') Sleep(200) ControlClick("Reemplazar", "", "[ID:4892]") Sleep(100) Send("{ALTDOWN}z{ALTUP}") Local $hWnd4 = WinWait("Microsoft Visual Basic", "Se ha buscado en la ", 2) ;WinActivate($hWnd4) ;WinWaitActive($hWnd4, "", 3) If WinActive($hWnd4, "") Then Sleep(100) Send("{SPACE}") Else Consolewrite("Not found 1: " & $aFileList[$i] & @CRLF) Local $hWnd5 = WinWait("Microsoft Visual Basic", "No se encontró", 0) ;WinActivate($hWnd5) ;WinWaitActive($hWnd5, "", 2) Sleep(100) Send("{SPACE}") EndIf Sleep(100) If WinActive($hWnd3, "") Then ;Alt+F4 Send("!{F4}") Sleep(100) EndIf EndIf ;Second Replace If WinActive($hWnd2, "") Then Send("{CTRLDOWN}h{CTRLUP}") ;Wait 30 seconds for the window to appear. Local $hWnd3 = WinWait("Reemplazar", "&Procedimiento actua", 30) WinActivate($hWnd3) WinWaitActive($hWnd3, "", 30) Sleep(100) Send('Sheets("DATOS").Range("AD8")') Sleep(200) Send("{TAB}") Sleep(100) Send('Range("Booking_FinalDest")') Sleep(200) ControlClick("Reemplazar", "", "[ID:4892]") Sleep(100) Send("{ALTDOWN}z{ALTUP}") Local $hWnd4 = WinWait("Microsoft Visual Basic", "Se ha buscado en la ", 2) ;WinActivate($hWnd4) ;WinWaitActive($hWnd4, "", 3) If WinActive($hWnd4, "") Then Sleep(100) Send("{SPACE}") Else Consolewrite("Not found 2: " & $aFileList[$i] & @CRLF) Local $hWnd5 = WinWait("Microsoft Visual Basic", "No se encontró", 0) ;WinActivate($hWnd5) ;WinWaitActive($hWnd5, "", 2) Sleep(100) Send("{SPACE}") EndIf Sleep(100) If WinActive($hWnd3, "") Then ;Alt+F4 Send("!{F4}") Sleep(100) EndIf EndIf ;Close VBE Editor If WinActive($hWnd2, "") Then $oAppl.VBE.ActiveWindow.Close ;Send("^{F4}") ;Sleep(100) ;Send("^s") $oAppl.VBE.MainWindow.Visible = False ;Sleep(100) ;Send("!{F4}") EndIf EndIf _Excel_BookClose($oWorkbook, True) ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_BookClose: " & $sFilePath & @CRLF & "@error = " & @error & ", @extended = " & @extended) EndIf Next Else MsgBox(16, "Error", "No files were found in the folder specified.") EndIf _Excel_Close($oAppl) ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_Close" & @CRLF & "@error = " & @error & ", @extended = " & @extended) ;This is a custom error handler Func ErrFunc() $HexNumber = Hex($oMyError.number, 8) ;~ MsgBox(0, "", "We intercepted a COM Error !" & @CRLF & _ ;~ "Number is: " & $HexNumber & @CRLF & _ ;~ "WinDescription is: " & $oMyError.windescription) ConsoleWrite("-> We intercepted a COM Error !" & @CRLF & _ "-> err.number is: " & @TAB & $HexNumber & @CRLF & _ "-> err.source: " & @TAB & $oMyError.source & @CRLF & _ "-> err.windescription: " & @TAB & $oMyError.windescription & _ "-> err.scriptline is: " & @TAB & $oMyError.scriptline & @CRLF) $iEventError = 1 ; Use to check when a COM Error occurs EndFunc ;==>ErrFunc  
    • gahhon
      By gahhon
      Hi Guys,
      I was trying to read some data from the excel file and without opening the file. But I tried a lot of methods, it still open the file.
      And also, I am able to capture the ColumnA value but not Column B.
      Thanks for advance information.
      Global $oDataA, $oDataB Call ("ExcelRead", "B2", "C2") Func ExcelRead($oColumnA, $oColumnB) Local $oPath = @ScriptDir & "\MyFile.xlsx" Local $oExcel = _Excel_Open() Local $oWorkbook = _Excel_BookOpen($oExcel, $oPath, 1, 0) $oDataA = _Excel_RangeRead($oWorkbook, "Sheet 1", $oColumnA) $oDataB = _Excel_RangeRead($oWorkbook, "Sheet 1", $oColumnB) MsgBox(0, "Test Value", $oDataA & ", " & $oDataB) EndFunc  
    • ed973
      By ed973
      I really don't understand how to save as an open excel sheet.
      I run a script that at the end open the excel: just only need to save as the opened excel on my desktop (and overwrite it everytime).
      I'm trying to use .ActiveWorkBook.SaveAs("C:\Users\Enrico\Desktop\impegnato.xlsx") but...
       
      Thanks in advance for helping.
    • yasha
      By yasha
      i want am trying to select a nimber to run a program and then select where to save the excel result at before hand
      the problem is that it does not save in the folder i want but the folder before any solutions
      #.................
      $sFolder = ""
          ; Create a constant variable in Local scope of the message to display in FileSelectFolder.
          Local Const $sMessage = "Select a folder"
          ; Display an open dialog to select a file.
          $sFileSelectFolder = FileSelectFolder($sMessage, $sFolder)
          If @error Then
              ; Display the error message.
              MsgBox($MB_SYSTEMMODAL, "", "No folder was selected.")
          Else
              ; Display the selected folder.
              MsgBox($MB_SYSTEMMODAL, "", "You chose the following folder:" & @CRLF & $sFileSelectFolder)
          EndIf
      .......
      ........
      $oExcel = ObjCreate("Excel.Application")                   ; Create an Excel Object
      $oExcel.Visible = 1                                        ; Let Excel show itself
      $oExcel.Workbooks.Open("J:\OPS\OPS_Share\Planners\2 - Weekly Reports\Auto download\"& $YY & $MM & $DD & " ORDER.xls",0)
      $oExcel.ActiveWorkbook.Saveas ( $sFileSelectFolder,""& $YY & $MM & $DD & " ORDER.xlsx", 1)
      $oExcel.ActiveWorkBook.Close
      $oExcel.Quit
      i only want to save it as ddmmyy order inside documents but it saves in libraries as documents ddmmyy order.
    • PiyushJhawar
      By PiyushJhawar
      I am part of QA team of an analytics application. We support third party tools like Excel , Tableue .
      I have to write automation script that connect Excel to our analytics application. In short i want below to automate
      > Open Excel
      > Click on "Data" option available in header and then click on "From Other Services " then click on "From Analysis Services"
      > It will open pop up and then need to write username password there.
      I am new in this tool . Can any one please provide me link of any document that help me to create above script
×