Help with battleships VBA code

Z

zakwilce

New Member
Joined
Apr 19, 2018
Messages
5
I've been stuck on this for so long, i have no idea how to fix the bugs that keep occurring. Please could someone point out the bugs i have made and how to fix them.

Code: 
Sub draw_ship(lengthy, board)
Dim completed As Integer
Dim sum As Integer
Dim i As Integer
Dim iy As Integer
Dim iend As Integer


Randomize


completed = 0
Do While (completed = 0)
  ix = Int((((9 - lengthy)) - 0 + 1) * Rnd() + 0)
  iy = Int((9 - 0 + 1) * Rnd() + 0)
  sum = 0
  iend = ix + lengthy - 1
  For i = ix To iend Step 1
    sum = sum + board(iy, i)
  Next i
  If (sum = 0) Then
    Rem paint in ship
    For i = ix To iend Step 1
      board(iy, i) = lengthy
    Next i
    completed = 1
  End If
Loop
End Sub
Sub pick_a_square(ix, y)
  Dim inputted As Integer
  inputted = InputBox("Please enter 2 coord digits")
  iy = Int(inputted / 10#)
  ix = inputted Mod 10
End Sub
Sub battleships()
Dim board(10, 10) As Integer
Dim i As Integer
Dim j As Integer
Dim ix As Integer
Dim iy As Integer
Dim ship As Integer
Dim totally(5) As Integer
Dim fleet(4) As Integer
Dim score As Integer




Rem initialize the boards
For j = 0 To 9 Step 1
  For i = 0 To 9 Step 1
    board(j, i) = 0
    Cells(3 + j, 8 + i).Value = " "
  Next i
Next j


Rem now initialise the fleet No. of squares not sunk
fleet(4) = 1 * 5 ' aircraft carrier 5 squares long
fleet(3) = 2 * 4 ' battleship 4 squares long
fleet(2) = 3 * 3 ' frigate 3 squares long
fleet(1) = 4 * 2 ' mine sweeper 2 squares long


Rem now let VBA fill up the board with ships
For i = 1 To 10
  If (i = 1) Then ' Aircraft Carrier
    ship = 5
    Call draw_ship(ship, bored)
  End If
  If ((i >= 2) And (i <= 3)) Then ' Battleship
    ship = 4
    Call draw_ship(ship, board)
  End If
  If ((i >= 4) And (i <= 6)) Then ' Frigate
    ship = 3
    Call draw_ship(ship, board)
  End If
  If ((i >= 7) And (i <= 20)) Then ' Mine Sweeper
    ship = 2
    Call draw_ship(ship, board)
  End If
Next i


Rem now we let the human user go and blow up all the ships
score = 0
Do While (score < 30)
  Call pick_a_square(ix, iy)
  ship = board(iy, ix)
  If (ship > 0) Then
    Cells(3 + iy, 8 + ix).Value = "X"
    score = score + 1
  Else
    Cells(3 + iy, 8 + ix).Value = "-"
  End If
  Cells(13, 4).Value = score
  If (ship < 0) Then fleet(ship) = fleet(ship) - 1
  For i = 2 To 5 Step 1
    totally(i) = fleet(i) / i
  Next i
  Cells(5, 4).Value = totally(3) ' Aircraft carrier
  Cells(7, 4).Value = totally(4) ' Battleship
  Cells(9, 4).Value = totally(3) ' Frigate
  Cells(11, 4).Value = totally(2) ' Mine Sweeper
Loop
  
End Sub
 
Last edited by a moderator:
Sort by date Sort by votes
Another prob
Code: 
Sub pick_a_square(ix, [COLOR=#ff0000]y[/COLOR])
  Dim inputted As Integer
  inputted = InputBox("Please enter 2 coord digits")
  [COLOR=#ff0000]iy [/COLOR]= Int(inputted / 10#)
  ix = inputted Mod 10
End Sub
As WBD said out Option Explicit at the very top of the module. That will help to flush out typos
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Thanks for the help guys, I've tried what you've said and it's almost there. Now i have a problem with the number of ships being drawn. I should have 4 Mine sweepers (which i do), 3 Frigates (which i do), 2 battleships(which i do) and 1 Aircraft carrier( but i have 3 instead of 1). Here's the updated vba:

Code: 
[COLOR=#333333]Option Explicit[/COLOR]
Sub draw_ship(lengthy, board)
Dim completed As Integer
Dim sum As Integer
Dim i As Integer
Dim iy As Integer
Dim iend As Integer


Randomize


completed = 0
Do While (completed = 0)
  ix = Int((((9 - lengthy)) - 0 + 1) * Rnd() + 0)
  iy = Int((9 - 0 + 1) * Rnd() + 0)
  sum = 0
  iend = ix + lengthy - 1
  For i = ix To iend Step 1
    sum = sum + board(iy, i)
  Next i
  If (sum = 0) Then
    Rem paint in ship
    For i = ix To iend Step 1
      board(iy, i) = lengthy
    Next i
    completed = 1
  End If
Loop
End Sub
Sub pick_a_square(ix, iy)
  Dim inputted As Integer
  inputted = InputBox("Please enter 2 coord digits")
  iy = Int(inputted / 10#)
  ix = inputted Mod 10
End Sub
Sub battleships()
Dim board(10, 10) As Integer
Dim i As Integer
Dim j As Integer
Dim ix As Integer
Dim iy As Integer
Dim ship As Integer
Dim totally(5) As Integer
Dim fleet(5) As Integer
Dim score As Integer




Rem initialize the boards
For j = 0 To 9 Step 1
  For i = 0 To 9 Step 1
    board(j, i) = 0
    Cells(3 + j, 8 + i).Value = " "
  Next i
Next j


Rem now initialise the fleet No. of squares not sunk
fleet(5) = 1 * 5 ' aircraft carrier 5 squares long
fleet(4) = 2 * 4 ' battleship 4 squares long
fleet(3) = 3 * 3 ' frigate 3 squares long
fleet(2) = 4 * 2 ' mine sweeper 2 squares long


Rem now let VBA fill up the board with ships
For i = 1 To 10
  If (i = 1) Then ' Aircraft Carrier
    ship = 5
    Call draw_ship(ship, board)
  End If
  If ((i >= 2) And (i <= 3)) Then ' Battleship
    ship = 4
    Call draw_ship(ship, board)
  End If
  If ((i >= 4) And (i <= 6)) Then ' Frigate
    ship = 3
    Call draw_ship(ship, board)
  End If
  If ((i >= 7) And (i <= 20)) Then ' Mine Sweeper
    ship = 2
    Call draw_ship(ship, board)
  End If
Next i


Rem now we let the human user go and blow up all the ships
score = 0
Do While (score < 30)
  Call pick_a_square(ix, iy)
  ship = board(iy, ix)
  If (ship > 0) Then
    Cells(3 + iy, 8 + ix).Value = "X"
    score = score + 1
  Else
    Cells(3 + iy, 8 + ix).Value = "-"
  End If
  Cells(13, 4).Value = score
  If (ship < 0) Then fleet(ship) = fleet(ship) - 1
  For i = 2 To 4 Step 1
    totally(i) = fleet(i) / i
  Next i
  Cells(5, 4).Value = totally(3) ' Aircraft carrier
  Cells(7, 4).Value = totally(4) ' Battleship
  Cells(9, 4).Value = totally(3) ' Frigate
  Cells(11, 4).Value = totally(2) ' Mine Sweeper
Loop
  
End Sub
 
Last edited by a moderator:
Upvote 0
Doesnt fix your problem but


Code: 
  If ((i >= 7) And (i <= 20)) Then ' Mine Sweeper
    ship = 2
    Call draw_ship(ship, board)
  End If

Your i loop only goes up to 10, so this should be 10 not 20
 
Last edited:
Upvote 0
Special-K99 said:
Doesnt fix your problem but


Code: 
  If ((i >= 7) And (i <= 20)) Then ' Mine Sweeper
    ship = 2
    Call draw_ship(ship, board)
  End If

Your i loop only goes up to 10, so this should be 10 not 20
Click to expand...

Ahh yes, thank you. I think i've got the vba to work now. It seems to be doing what i want now. Thank you for the help everyone
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Diagonal Sum in excel table via VBA code
2
Replies
11
Views
492
myall_blues
myall_blues
M
  • Question Question
Please help me to correct Excel VBA code!
Replies
1
Views
329
Minh Tuan VN
M
K
  • Solved
Using VBA to select a color coded cell
2
Replies
11
Views
933
Alex Blakenburg
A
L
  • Solved
IF Statement Added to VBA Code to Display Blank if Sum Equals 0
2
Replies
10
Views
774
Joe4
Joe4
S
  • Question Question
VBA code help
Replies
2
Views
464
stromnoexcel
S

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top