Hi I am new to Visual Basic and I am trying to replicate the agent spreadsheet model set out in North and Macal (2007).
Could someone please assist me? I have written out the code and worked out a few of the basics but the macro will not run. Being a complete begininer I am sure I am just missing something very obvious but as it stands I haven't a clue what that might be.
Please help!
Kind regards,
Gareth
P.S. If it helps I can send what I have done and maybe you can see where I am going wrong.
Hi I am new to Visual Basic and I am trying to replicate the agent spreadsheet model set out in North and Macal (2007).
Could someone please assist me? I have written out the code but don't really know how to link this to the spreadsheet so it works. Tried and failed. Excel will just not allow me to run it. Does anyone know what I am doing wrong.
Any help would be much appreciated.
Cheers
Gilehmi
' This is the main simulation routine. Sub Run() ' Initialize the model. Call Initialize 'Reset the current simulation time. [Current_Time] = 0 ' Check the current simulation time (Note that this is a synchorous model). Do While ([Current_Time] < [End_Time]) ' Let the shoppers shop. Call ActivateShoppers 'Note the averge customer frustration level. Call RecordAverageFrustration ' Set the current simulation time forward. [Current_Time] = [Current_Time] + [Time_Increment] Loop End Sub 'This is the initialization routine. Sub Initialize() ' Declare the local variables. Dim shopper As Range 'Set the random seed. Rnd (-1) Randomize ([Rand_Seed]) ' Reset the graph. [Frustration].Offset(1, 1) = 0 [Frustration].Offset(2, 1) = 0 [GraphLabels].Clear [GraphValues].Clear 'Initialize all of the shoppers. For Each shopper In [shoppers] 'Complete the basic shopper initialization. Call InitializeShopper(shopper) 'Reset the items found counter. shopper.Offset(0, 13) = 0 'Reset the trip counter. shopper.Offset(0, 14) = 0 'Start with a moderate frustration level. shopper.Offset(0, 12) = [Initial_Frustration] Next shopper End Sub 'The shopping shopper initialization routine. Sub InitializeShopper(shopper As Range) 'Remove the shopper from the store. Call ClearShopper(shopper) 'Reset the shopper's state. shopper.Offset(0, 5) = "Browsing" ' Set the shopper's starting location to the door. shoopper.Offset(0, 2) = 1 shopper.Offset(0, 3) = 1 'Have the shopper start by looking through the store 'store from the door to the back corner. shoopper.Offset(0, 10) = 21 shoopper.Offset(0, 11) = 27 shoopper.Offset(0, 6) = shoopper.Offset(0, 9) shoopper.Offset(0, 7) = shoopper.Offset(0, 10) shoopper.Offset(0, 8) = shoopper.Offset(0, 11) 'Place the shopper in the store. Call DrawShopper(shopper) End Sub 'The main group routine. Sub ActivateShoppers() 'Declare the local variables. Dim shopper As Range 'Allow all of the shoppers to execute. For Each shopper In [shoppers] 'Allow the next shopper to shop. Call Shop(shoppers) Next shopper Ext shopper End Sub ' This is the shopper clearing routine. Sub ClearShopper(shopper As Range) 'Clear the shopper from the display. [Environment].Offset(shopper.Offset(0, 2), _ shopper.Offset(0, 3)) = "" End Sub ' This is the shopper drawing routine. Sub DrawShopper(shopper As Range) 'Draw the shopper. [Environment].Offset(shopper.Offset(0, 2), _ shopper.Offset(0, 3)) = shopper.Offset(0, 4) End Sub 'The main shopper shopping routine. Sub Shop(shopper As Range) 'Check to see if we have found the target. If (shopper.Offset(0, 5) = "Waiting") Then 'Check to see if our wait is over. Call CheckWait(shopper) 'Check to see if the shopper is at the door 'and ready to leave the store. ElseIf ((shopper.Offset(0, 2) = 1) And _ (shopper.Offset(0, 3) = 4)) Then 'Note the finished trip. Call FinishTrip(shopper) 'Check to see if we have found the target. ElseIf (shopper.Offset(0, 5) = "Found") Then 'Check the target item. Call CheckTarget(shopper) 'Check to see if the shopper should leave the store. ElseIf (shopper.Offset(0, 5) - "Leaving") Then 'Move toward the door. Call MoveTowardTheDoor(shopper) 'Check to see if we are frustrated or distracted. ElseIf (shopper.Offset(0, 12) > Rnd()) Then 'Move randomly. Call MoveRandomly(shopper) Else 'Move toward the target using the 'Manhatten distance. Call MoveTowardTheTarget(shopper) End If 'Check to see if what we are looking for is nearby. Call LookAround(shopper) End Sub 'This is the wait checking routine. Sub CheckWait(shopper As Range) 'Check to see if our wait is over. If (Rnd() < 1 / [Average_Wait_Time]) Then 'Our wait is over. shopper.Offset(0, 5) = "Browsing" 'Note the trip. shopper.Offset(0, 14) = shopper.Offset(0, 14) + 1 End If End Sub 'This is the trip completion routine. Sub FinishTrip(shopper As Range) 'Reinitiate the shopper. Call InitializeShopper(shopper) 'Wait to return to the store. shopper.Offset(0, 5) = "Waiting" End Sub 'This is the target checking routine. Sub CheckTarget(shopper As Range) 'Check the target item. If (shopper.Offset(0, 6) = "$") Then 'A checkout counter was found se we should 'leave the store. shopper.Offset(0, 5) = "Leaving" 'Not that nothing is being sought. shopper.Offset(0, 6) = "~" 'A regular item was found. Else 'Note that an item was found. shopper.Offset(0, 13) = shopper.Offset(0, 13) + 1 'Check to see if we will remember where we 'found the item If (Rnd() <= [Memory_Probability]) Then 'Remember where we found the item. shopper.Offset(0, 10) = shopper.Offset(0, 2) shopper.Offset(0, 11) = shopper.Offset(0, 3) End If 'Select the checkout counter area as the 'next target. shopper.Offset(0, 5) = "checkout" shopper.Offset(0, 6) = "$" shopper.Offset(0, 7) = 3 shopper.Offset(0, 8) = 21 End If End Sub 'This is the routine that moves us in a random 'direction Sub MoveRandomly(shopper As Range) 'Declare the local variables. Dim nextRow As Integer Dim nextColumn As Integer 'Move randomly. nextRow = Round((shopper.Offset(0, 2) + _ 2 * Rnd() - 1), 0) nextColumn = Round((shopper.Offset(0, 3) + _ 2 * Rnd() - 1), 0) 'Try to complete the proposed movement. Call CompleteMove(shopper, nextRow, nextColumn) End Sub 'This is the routine that moves us toward the 'target using the Manhatan distance. Sub MoveTowardTheTarget(shopper As Range) 'Declare the local variables. Dim nextRow As Integer Dim nextColumn As Integer Dim delta As Integer 'Select a neighboring row. delta = shopper.Offset(0, 7) - shopper.Offset(0, 2) If (delta > 0) Then nextRow = shopper.Offset(0, 2) + 1 ElseIf (delta = 0) Then nextRow = shopper.Offset(0, 2) Else nextRow = shopper.Offset(0, 2) - 1 End If 'Try to complete the proposed movement. Call CompleteMove(shopper, nextRow, nextColumn) 'Select a neighboring column. delta = shopper.Offset(0, 8) - shopper.Offset(0, 3) If (delta > 0) Then nextColumn = shopper.Offset(0, 3) + 1 ElseIf (delta = 0) Then nextColumn = shopper.Offset(0, 3) Else nextColumn = shopper.Offset(0, 3) - 1 End If 'Try to complete the proposed movement. Call CompleteMove(shopper, nextRow, nextColumn) End Sub 'This is the routine that moves us toward the door. Sub MoveTowardTheDoor(shopper As Range) 'Declare the local variables. Dim nextRow As Integer Dim nextColumn As Integer 'Move toward the door. nextRow = shopper.Offset(0, 2) nextColumn = shopper.Offset(0, 3) If (nextRow > 1) Then nextRow = nextRow - 1 End If If ((nextRow = 1) And (nextColumn > 4)) Then nextColumn = nextColumn - 1 End If 'Try to complete the proposed movement. Call CompleteMove(shopper, nextRow, nextColumn) End Sub 'This is the routine that completes the proposed 'movement. Sub CompleteMove(shopper As Range, _ nextRow As Integer, nextColumn As Integer) 'Declare the local variables. Dim floorColor As Long Dim nextCellColor As Long 'Note the floor color. floorColor = RGB(255, 255, 255) 'Check for walls and other shoppers to avoid bumping. nextCellColor = [Environment].Offset(nextRow, _ nextColumn).Interior.Color If ((nextCellColor = floorColor) _ And ([Environment].Offset(nextRow, nextColumn) = "")) _ Then 'There is nothing in the way so move the next 'location. 'Clear the current shopper location. Call ClearShopper(shopper) 'Assign the new location. shopper.Offset(0, 2) = nextRow shopper.Offset(0, 3) = nextColumn 'Move the shopper to the new location. Call DrawShopper(shopper) 'Become less frustrated every time we can move. Call FeelBetter(shopper) Else 'Become more frustrated every time we are blocked. Call FeelWorse(shopper) End If End Sub 'This is the routine that makes us feel better 'every time we can move forward. Sub FeelBetter(shopper As Range) 'Become less frustrated every time we can move. shopper.Offset(0, 12) = shopper.Offset(0, 12) - _ [Frustration_Increment] If (shopper.Offset(0, 12) < 0) Then shopper.Offset(0, 12) = 0 End If End Sub 'This is the routine that makes us feel worse 'every time we are blocked. Sub FeelWorse(shopper As Range) 'Become more frustrated every time we are blocked. shopper.Offset(0, 12) = shopper.Offset(0, 12) + _ [Frustration_Increment] If (shopper.Offset(0, 12) >= 1) Then 'Give up if we have not found what we are 'looking for. If (shopper.Offset(0, 5) = "Browsing") Then 'Abandon the shopping without finding the item. 'Select the checkout counter area as the next 'target. shopper.Offset(0, 5) = "Checkout" shopper.Offset(0, 6) = "$" shopper.Offset(0, 7) = 3 shopper.Offet(0, 8) = 21 End If 'Note that there is a limit to our frustration. shopper.Offset(0, 12) = 1 End If End Sub 'This is the nearby area scanning routine. Sub LookAround(shopper As Range) 'Check the eight neighboring squares to see if our item 'is nearby. For Row = -1 To 1 'For simplicity we will check our own square too, 'but do not expect to find the item we seek. For Column = -1 To 1 'Check the next nearby spot for our item. If ([Environment].Offset(shopper.Offset(0, 2) + Row, _ shopper.Offset(0, 3) + Column) = _ shopper.Offset(0, 6)) Then ''Note that we have found the item of interest. shopper.Offset(0, 5) = "Found" Exit For End If Next Column Next Row End Sub 'This is the average frustration recording routine. Sub RecordAverageFrustration() 'Record the average customer frustration level. [Frustration].Offset([Current_Time] / _ [Time_Increment] + 1, 0) = [Current_Time] [Frustration].Offset([Current_Time] / _ [Time_Increment] + 1, 1) = [Average_Frustration] End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.