Click here to Skip to main content
14,699,006 members
Please Sign up or sign in to vote.
1.00/5 (3 votes)
See more:
Option Explicit

Private Type Record 'create a structure for storing the data of previous, next location and sleep counter for a particular node
current_x As Integer
current_y As Integer
previous_x As Integer
previous_y As Integer
sleep_count As Integer
End Type



Sub Simulation()


Dim n1 As Record
Dim sleepcount As Integer
Dim p() As Variant
Dim Size As Integer
sleepcount = 0
Do
If ActiveCell.Interior.Color = RGB(216, 216, 216) Then 'if it is a Sink
If sleepcount = 0 Then 'if sleepcount is 0 then update the node's data and move forward
n1.previous_x = ActiveCell.Row
n1.previous_y = ActiveCell.Column
p = NextNodeForSink()
If p(0, 0) = n1.previous_x And p(0, 1) = n1.previous_y Then 'if the new location is repeated then ask for a new location again
p = NextNodeForSink()
Cells(p(0, 0), p(0, 1)).Value = ActiveCell.Value
'ActiveCell.Value = Replace(ActiveCell.Value, Cells(p(0, 0), p(0, 1)).Value, "") 'Move that node in next location and remove than node from the previous location
Cells(p(0, 0), p(0, 1)).Activate
n1.current_x = ActiveCell.Row
n1.current_y = ActiveCell.Column
n1.sleep_count = sleepcount
Else
Cells(p(0, 0), p(0, 1)).Value = ActiveCell.Value
'ActiveCell.Value = Replace(ActiveCell.Value, Cells(p(0, 0), p(0, 1)).Value, "") 'Move that node in next location and remove than node from the previous location
Cells(p(0, 0), p(0, 1)).Activate
n1.current_x = ActiveCell.Row
n1.current_y = ActiveCell.Column
n1.sleep_count = sleepcount
End If
End If
ElseIf ActiveCell.Interior.Color = RGB(155, 187, 89) Then 'if it is a path
p = NextNodeForPath() 'Do the same task as above
If p(0, 0) = n1.previous_x And p(0, 1) = n1.previous_y Then
p = NextNodeForPath()
Cells(p(0, 0), p(0, 1)).Value = ActiveCell.Value
'ActiveCell.Value = Replace(ActiveCell.Value, Cells(p(0, 0), p(0, 1)).Value, "")
Cells(p(0, 0), p(0, 1)).Activate
n1.current_x = ActiveCell.Row
n1.current_y = ActiveCell.Column
n1.sleep_count = sleepcount
Else
Cells(p(0, 0), p(0, 1)).Value = ActiveCell.Value
'ActiveCell.Value = Replace(ActiveCell.Value, Cells(p(0, 0), p(0, 1)).Value, "") 'Move that node in next location and remove than node from the previous location
Cells(p(0, 0), p(0, 1)).Activate
n1.current_x = ActiveCell.Row
n1.current_y = ActiveCell.Column
n1.sleep_count = sleepcount
End If

If ActiveCell.Interior.Color = RGB(155, 187, 89) Then 'if the new location is a sink then set sleep counter
sleepcount = 1
If sleepcount = 0 Then 'if sleep count is 0 then call for next location
p = NextNodeForSink()
If p(0, 0) = n1.previous_x And p(0, 1) = n1.previous_y Then
p = NextNodeForSink()
Cells(p(0, 0), p(0, 1)).Value = ActiveCell.Value
'ActiveCell.Value = Replace(ActiveCell.Value, Cells(p(0, 0), p(0, 1)).Value, "")
Cells(p(0, 0), p(0, 1)).Activate
n1.current_x = ActiveCell.Row
n1.current_y = ActiveCell.Column
n1.sleep_count = sleepcount
Else
Cells(p(0, 0), p(0, 1)).Value = ActiveCell.Value
'ActiveCell.Value = Replace(ActiveCell.Value, Cells(p(0, 0), p(0, 1)).Value, "")
Cells(p(0, 0), p(0, 1)).Activate
n1.current_x = ActiveCell.Row
n1.current_y = ActiveCell.Column
n1.sleep_count = sleepcount
End If
Else
sleepcount = sleepcount - 1 'else decrement the sleepcounter
End If
End If
End If
Loop While ActiveCell.Row <> 19 And ActiveCell.Column <> 2

End Sub





Function NextNodeForSink() As Variant

Dim i As Integer
i = 0
Dim a(10, 2) As Variant
If ActiveCell.Offset(-1, 0).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(-1, 0).Row
a(i, 1) = ActiveCell.Offset(-1, 0).Column
i = i + 1
End If
If ActiveCell.Offset(1, 0).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(1, 0).Row
a(i, 1) = ActiveCell.Offset(1, 0).Column
i = i + 1
End If
If ActiveCell.Offset(0, -1).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(0, -1).Row
a(i, 1) = ActiveCell.Offset(0, -1).Column
i = i + 1
End If
If ActiveCell.Offset(0, 1).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(0, 1).Row
a(i, 1) = ActiveCell.Offset(0, 1).Column
i = i + 1
End If
If ActiveCell.Offset(-1, 1).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(-1, 1).Row
a(i, 1) = ActiveCell.Offset(-1, 1).Column
i = i + 1
End If
If ActiveCell.Offset(-1, -1).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(-1, -1).Row
a(i, 1) = ActiveCell.Offset(-1, -1).Column
i = i + 1
End If
If ActiveCell.Offset(1, -1).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(1, -1).Row
a(i, 1) = ActiveCell.Offset(1, -1).Column
i = i + 1
End If
If ActiveCell.Offset(1, 1).Interior.Color = RGB(155, 187, 89) Then
a(i, 0) = ActiveCell.Offset(1, 1).Row
a(i, 1) = ActiveCell.Offset(1, 1).Column
i = i + 1
End If

Dim t(1, 2) As Variant
Dim count As Integer
Dim temp As Integer

count = 0
temp = Int((100 - 1 + 1) * Rnd + 1)
Do While count <> (UBound(a, 1) + 1)
If temp >= count And temp < (count + 1) * 100 / (UBound(a, 1) + 1) Then
t(0, 0) = a(count, 0)
t(0, 1) = a(count, 1)
Exit Do
Else
count = count + 1
End If
Loop

NextNodeForSink = t

End Function




Function NextNodeForPath() As Variant
Dim i As Integer
i = 0
Dim a(10, 2) As Variant
If ActiveCell.Offset(-1, 0).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(-1, 0).Row
a(i, 1) = ActiveCell.Offset(-1, 0).Column
i = i + 1
End If
If ActiveCell.Offset(1, 0).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(1, 0).Row
a(i, 1) = ActiveCell.Offset(1, 0).Column
i = i + 1
End If
If ActiveCell.Offset(0, -1).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(0, -1).Row
a(i, 1) = ActiveCell.Offset(-1, -1).Column
i = i + 1
End If
If ActiveCell.Offset(0, 1).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(0, 1).Row
a(i, 1) = ActiveCell.Offset(0, 1).Column
i = i + 1
End If
If ActiveCell.Offset(-1, 1).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(-1, 1).Row
a(i, 1) = ActiveCell.Offset(-1, 1).Column
i = i + 1
End If
If ActiveCell.Offset(-1, -1).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(-1, -1).Row
a(i, 1) = ActiveCell.Offset(-1, -1).Column
i = i + 1
End If
If ActiveCell.Offset(1, -1).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(1, -1).Row
a(i, 1) = ActiveCell.Offset(1, -1).Column
i = i + 1
End If
If ActiveCell.Offset(1, 1).Interior.Color = RGB(155, 187, 89) Or ActiveCell.Offset(-1, 0).Interior.Color = RGB(216, 216, 216) Then
a(i, 0) = ActiveCell.Offset(1, 1).Row
a(i, 1) = ActiveCell.Offset(1, 1).Column
i = i + 1
End If

Dim t(1, 2) As Variant
Dim count As Integer
Dim temp As Integer

count = 0
temp = Int((100 - 1 + 1) * Rnd + 1)
Do While count <> (UBound(a, 1) + 1)
If temp >= count And temp < (count + 1) * 100 / (UBound(a, 1) + 1) Then
t(0, 0) = a(count, 0)
t(0, 1) = a(count, 1)
Exit Do
Else
count = count + 1
End If
Loop

NextNodeForPath = t


End Function






Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub
Posted
Comments
Richard MacCutchan 5-Feb-15 3:52am
   
Please edit your question and:
- remove all the code not connected to the question
- format it properly
- explain what the problem is
- show exactly where the problem occurs.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

  Print Answers RSS
Top Experts
Last 24hrsThis month



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900