PDA

View Full Version : [SOLVED] Help with solving a maze in VBA Excel



JazzlikeSwan
03-01-2018, 08:50 PM
So this is a pretty easy task but I do not VBA at all and can not seem it figure it out . It is basically writing a VBA sub procedure for a 15x15 maze that begins in c3 and ends in q17. Simple D = down, R = right, L = left, U = up I know it should start with Sub Path Finder () but do not know how to build after. If someone could explain it would be greatly appreciated.

georgiboy
03-02-2018, 05:22 AM
There is not enough detail in your question, for example if this was a maze then what would the dead ends and walls consist of? What would happen if you hit a wall? Where is the end goal?
Why does it have to use keys d r l u instead of the arrow pad?
Seems like a pretty strange task for excel also, is this some kind of homework?

SamT
03-02-2018, 08:21 AM
So this is a pretty easy task Wrong! It's a very difficult task.

First question: How does one solve a 'Blind Maze,' one where you can't see any part of the maze except where you are standing? Because VBA is blind in that sense.

How does BA handle dead end Paths and wall ends?

JazzlikeSwan
03-02-2018, 10:46 AM
There is not enough detail in your question, for example if this was a maze then what would the dead ends and walls consist of? What would happen if you hit a wall? Where is the end goal?
Why does it have to use keys d r l u instead of the arrow pad?
Seems like a pretty strange task for excel also, is this some kind of homework?

The purpose is the minute you hit run it automatically solves the maze. You dont actually play the game. Each cell has either L R D U to indicate up down left rigjt and it should read that so it would not hit the wall.

georgiboy
03-02-2018, 10:52 AM
What are the walls made of?
Would it need to move through the maze visually or report its route with data?
Excel will do this almost instantly so if you want to see a route then you would have to slow it down, is that what you want to do?

I am viewing this that every second for example you would like it to move a space and display the move?

JazzlikeSwan
03-02-2018, 11:23 AM
Every box that it moves through before getting to the end of would either be a different color or a * in that box or something to show the path.

JazzlikeSwan
03-02-2018, 11:24 AM
What are the walls made of?
Would it need to move through the maze visually or report its route with data?
Excel will do this almost instantly so if you want to see a route then you would have to slow it down, is that what you want to do?

I am viewing this that every second for example you would like it to move a space and display the move?
Every box that it moves through before getting to the end of would either be a different color or a * in that box or something to show the path.

SamT
03-02-2018, 11:49 AM
Each cell has either L R D U to indicate up down left rigjt and it should read that so it would not hit the wall.OK, it is not a MAZE, it is a PATH.

Sub PATHer()
Dim Cel As Range
Set cel = Range("???") 'set starting cell here
Do While Cel.address <> "$?$?" 'Insert end cell address here in $A$1 style
Select Case Cel.Value
Case "R": Set Cel = Cel.Offset(0, 1)
Case "L": Set Cel = Cel.Offset(0, -1)
Case "U": Set Cel = Cel.Offset(-1, 0)
Case "D": Set Cel = Cel.Offset(1, 0)
End Select
Loop
End Sub

georgiboy
03-02-2018, 12:49 PM
Ahh a path,

Smart code SamT

If you wanted to follow the path visually would this need a Cel.Activate line?

SamT
03-02-2018, 04:17 PM
If you wanted to follow the path visually would this need a Cel.Activate line?
No. VBA operates directly on the declared Object


Range("A1").Activate
Set Cel =Range("B2")
Cel. Value = "X"
Cel.Interior.Color = vbRed
'A1 is still "activated"
ActiveCell.Value = "Z"

JazzlikeSwan
03-02-2018, 09:05 PM
OK, it is not a MAZE, it is a PATH.

Sub PATHer()
Dim Cel As Range
Set cel = Range("???") 'set starting cell here
Do While Cel.address <> "$?$?" 'Insert end cell address here in $A$1 style
Select Case Cel.Value
Case "R": Set Cel = Cel.Offset(0, 1)
Case "L": Set Cel = Cel.Offset(0, -1)
Case "U": Set Cel = Cel.Offset(-1, 0)
Case "D": Set Cel = Cel.Offset(1, 0)
End Select
Loop
End Sub




Thank you so much. For some reason it won't run. How would one specify that it should show its path ..either by some color or symbol?

SamT
03-03-2018, 07:54 AM
For some reason it won't run
Probably because there is no such Range as Range("???"), nor such Range Address as "$?$?"


either by some color or symbol? See Post #10

JazzlikeSwan
03-03-2018, 08:03 AM
I set the Range (???) to my starting cell & $?$? to my ending cell but it still wont run.

JazzlikeSwan
03-03-2018, 08:04 AM
Probably because there is no such Range as Range("???"), nor such Range Address as "$?$?"

See Post #10

set the Range (???) to my starting cell (c3) & $?$? ($q$17)to my ending cell but it still wont run.

JazzlikeSwan
03-03-2018, 08:12 AM
Probably because there is no such Range as Range("???"), nor such Range Address as "$?$?"

See Post #10

217370


That is the maze

snb
03-03-2018, 08:17 AM
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4:K10")) Is Nothing Then Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), (UCase(Target) = "L") - (UCase(Target) = "R"))
End Sub

SamT
03-03-2018, 08:28 AM
it still wont run. Maybe it needs a new battery:devil2:

Seriously, "It won't run" is not enough information to discover the problem.

JazzlikeSwan
03-03-2018, 08:30 AM
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4:K10")) Is Nothing Then Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), (UCase(Target) = "L") - (UCase(Target) = "R"))
End Sub

Can you explain that

JazzlikeSwan
03-03-2018, 08:33 AM
Maybe it needs a new battery:devil2:

Seriously, "It won't run" is not enough information to discover the problem.

21738

This should be the end result once the code is run

georgiboy
03-03-2018, 08:42 AM
The thing that is being missed here as far as i can see is:

The code works perfectly but does not show the user visually what is happening, what we get is Cel holding the address of the goal when the code has run.

I was thinking (post 9) that it would be nice if the user could see the path visually.


Sub PATHer()
Dim Cel As Range
Set Cel = Range("C3") 'set starting cell here
Do While Cel.Address <> "$Q$18" 'Insert end cell address here in $A$1 style
Select Case Cel.Value
Case "R": Set Cel = Cel.Offset(0, 1)
Case "L": Set Cel = Cel.Offset(0, -1)
Case "U": Set Cel = Cel.Offset(-1, 0)
Case "D": Set Cel = Cel.Offset(1, 0)
End Select
Cel.Interior.Color = vbRed
Loop
End Sub

JazzlikeSwan
03-03-2018, 08:48 AM
THANKKKK YOUUUUUUUUUUUUUUUUUUUUUUUUU:yes:yes:yes:yes:yes:yes:yes:yes:yes:yes:yes:yes :yes

JazzlikeSwan
03-03-2018, 08:55 AM
The thing that is being missed here as far as i can see is:

The code works perfectly but does not show the user visually what is happening, what we get is Cel holding the address of the goal when the code has run.

I was thinking (post 9) that it would be nice if the user could see the path visually.


Sub PATHer()
Dim Cel As Range
Set Cel = Range("C3") 'set starting cell here
Do While Cel.Address <> "$Q$18" 'Insert end cell address here in $A$1 style
Select Case Cel.Value
Case "R": Set Cel = Cel.Offset(0, 1)
Case "L": Set Cel = Cel.Offset(0, -1)
Case "U": Set Cel = Cel.Offset(-1, 0)
Case "D": Set Cel = Cel.Offset(1, 0)
End Select
Cel.Interior.Color = vbRed
Loop
End Sub

THANK YOU:yes:yes:yes

SamT
03-03-2018, 11:34 AM
:rofl:

snb
03-03-2018, 02:51 PM
or:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C3:Q17")) Is Nothing Then
Target.Interior.ColorIndex = 5
Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), (UCase(Target) = "L") - (UCase(Target) = "R"))
End If
End Sub

SamT
03-03-2018, 04:01 PM
@ JazzlikeSwan

False = 0, True = -1

Only one is true, or both are false

(UCase(Target) = "U") - (UCase(Target) = "D")
-1 = up, --1 = down. (In first .Offset Parameter)

SamT
03-03-2018, 04:10 PM
@ snb,
WOW, click anywhere in Maze and watch it solve, OK, it will be too fast to actually watch.

Better slow it down a bit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For i = 1 to 6000: Next

If Not Intersect(Target, Range("C3:Q17")) Is Nothing Then
Target.Interior.ColorIndex = 5
Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), _
(UCase(Target) = "L") - (UCase(Target) = "R"))
End If
End Sub

snb
03-04-2018, 02:42 AM
or

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C3:Q17")) Is Nothing Then
Target.Interior.ColorIndex = 5
Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), (UCase(Target) = "L") - (UCase(Target) = "R"))
application.wait 1
End If
End Sub

snb
03-04-2018, 08:58 AM
Revised

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C3:Q17")) Is Nothing Then
application.wait Now + 1 / 43200
Target.Interior.ColorIndex = 5
Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), (UCase(Target) = "L") - (UCase(Target) = "R"))
End If
End Sub

SamT
03-04-2018, 09:45 AM
Also revised

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For i = 1 to 4000: Next

If Not Intersect(Target, Range("C3:Q17")) Is Nothing Then
Target.Interior.ColorIndex = 5
Application.Goto Target.Offset((UCase(Target) = "U") - (UCase(Target) = "D"), _
(UCase(Target) = "L") - (UCase(Target) = "R"))
End If
End Sub

snb
03-04-2018, 09:57 AM
Much better :):think:

SamT
03-04-2018, 10:42 AM
:devil2: