Getting Error 1004 - Application Defined or Object defined error

See more:

MS-Excel

VBA

VB12

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