VBA codes slow execution?

O

onainem

New Member
Joined
May 20, 2013
Messages
3
Why is this code executing so slow?

Sub AIPlacing()


Dim x As Integer
Dim y As Integer
Dim row As Integer
Dim row2 As Integer
Dim row3 As Integer
Dim row4 As Integer
Dim column As Integer
Dim column2 As Integer
Dim column3 As Integer
Dim column4 As Integer
Dim AIDirection As String
Dim checker As Boolean
Dim length As Integer
Dim numoftiles As Single






Do


x = 0
y = 0


For x = 9 To 18
For y = 24 To 33
Sheet2.Cells(x, y) = ""
Next y
Next x


x = 0
y = 0


'AIRCRAFT CARRIER
length = 4
row = Sheet2.Cells(28, 6)
column = Sheet2.Cells(28, 6)


Sheet2.Cells(3, 2) = row
Sheet2.Cells(4, 2) = column


row = Sheet2.Cells(3, 2)
column = Sheet2.Cells(4, 2)


'Up
If row - length > 0 Then
Sheet2.Cells(27, 9) = "=RAND()"
Else
Sheet2.Cells(27, 9) = ""
End If
'Down
If row + length <= 10 Then
Sheet2.Cells(28, 9) = "=RAND()"
Else
Sheet2.Cells(28, 9) = ""
End If
'Left
If column - length > 0 Then
Sheet2.Cells(29, 9) = "=RAND()"
Else
Sheet2.Cells(29, 9) = ""
End If
'Right
If column + length <= 10 Then
Sheet2.Cells(30, 9) = "=RAND()"
Else
Sheet2.Cells(30, 9) = ""
End If


'AIDirection


Sheet2.Cells(1, 4) = Sheet2.Cells(30, 6)
AIDirection = Sheet2.Cells(1, 4)


If AIDirection = "Up" Then
For x = 1 To length
Sheet2.Cells(3, 2 + x) = row - x
Sheet2.Cells(4, 2 + x) = column
Next x


ElseIf AIDirection = "Down" Then
For x = 1 To length
Sheet2.Cells(3, 2 + x) = row + x
Sheet2.Cells(4, 2 + x) = column
Next x


ElseIf AIDirection = "Left" Then
For x = 1 To length
Sheet2.Cells(3, 2 + x) = row
Sheet2.Cells(4, 2 + x) = column - x
Next x


ElseIf AIDirection = "Right" Then
For x = 1 To length
Sheet2.Cells(3, 2 + x) = row
Sheet2.Cells(4, 2 + x) = column + x
Next x


End If




'BATTLE CRUISER
length = 3


Do
row2 = Sheet2.Cells(32, 6)
column2 = Sheet2.Cells(32, 6)


Sheet2.Cells(8, 2) = row2
Sheet2.Cells(9, 2) = column2


row2 = Sheet2.Cells(8, 2)
column2 = Sheet2.Cells(9, 2)


'Up
For a = 1 To length + 1
For b = 1 To length
Sheet2.Cells(8, b + 1) = row2 - (b - 1)
Sheet2.Cells(9, b + 1) = column2
If Sheet2.Cells(8, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(9, b + 1) = Sheet2.Cells(4, a + 1) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row2 - length > 0 And checker = True Then
Sheet2.Cells(31, 9) = "=RAND()"
Else
Sheet2.Cells(31, 9) = ""
End If


'Down
For a = 1 To length + 1
For b = 1 To length
Sheet2.Cells(8, b + 1) = row2 + (b - 1)
Sheet2.Cells(9, b + 1) = column2
If Sheet2.Cells(8, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(9, b + 1) = Sheet2.Cells(4, a + 1) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row2 + length <= 10 And checker = True Then
Sheet2.Cells(32, 9) = "=RAND()"
Else
Sheet2.Cells(32, 9) = ""
End If


'Left
For a = 1 To length + 1
For b = 1 To length
Sheet2.Cells(8, b + 1) = row2
Sheet2.Cells(9, b + 1) = column2 - (b - 1)
If Sheet2.Cells(8, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(9, b + 1) = Sheet2.Cells(4, a + 1) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If column2 - length > 0 And checker = True Then
Sheet2.Cells(33, 9) = "=RAND()"
Else
Sheet2.Cells(33, 9) = ""
End If


'Right
For a = 1 To length + 1
For b = 1 To length
Sheet2.Cells(8, b + 1) = row2
Sheet2.Cells(9, b + 1) = column2 + (b - 1)
If Sheet2.Cells(8, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(9, b + 1) = Sheet2.Cells(4, a + 1) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If column2 + length <= 10 And checker = True Then
Sheet2.Cells(34, 9) = "=RAND()"
Else
Sheet2.Cells(34, 9) = ""
End If
Loop Until Sheet2.Cells(34, 6) <> ""


'AIDirection


Sheet2.Cells(6, 4) = Sheet2.Cells(34, 6)
AIDirection = Sheet2.Cells(6, 4)
x = 0
If AIDirection = "Up" Then
For x = 1 To length
Sheet2.Cells(8, 2 + x) = row2 - x
Sheet2.Cells(9, 2 + x) = column2
Next x


ElseIf AIDirection = "Down" Then
For x = 1 To length
Sheet2.Cells(8, 2 + x) = row2 + x
Sheet2.Cells(9, 2 + x) = column2
Next x


ElseIf AIDirection = "Left" Then
For x = 1 To length
Sheet2.Cells(8, 2 + x) = row2
Sheet2.Cells(9, 2 + x) = column2 - x
Next x


ElseIf AIDirection = "Right" Then
For x = 1 To length
Sheet2.Cells(8, 2 + x) = row2
Sheet2.Cells(9, 2 + x) = column2 + x
Next x


End If


'FRIGATE
length = 2


Do
row3 = Sheet2.Cells(36, 6)
column3 = Sheet2.Cells(36, 6)


Sheet2.Cells(13, 2) = row3
Sheet2.Cells(14, 2) = column3


row3 = Sheet2.Cells(13, 2)
column3 = Sheet2.Cells(14, 2)


'Up
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(13, b + 1) = row3 - (b - 1)
Sheet2.Cells(14, b + 1) = column3
If (Sheet2.Cells(13, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(13, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(9, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 - length > 0 And checker = True Then
Sheet2.Cells(35, 9) = "=RAND()"
Else
Sheet2.Cells(35, 9) = ""
End If


'Down
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(13, b + 1) = row3 + (b - 1)
Sheet2.Cells(14, b + 1) = column3
If (Sheet2.Cells(13, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(13, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(9, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 + length <= 10 And checker = True Then
Sheet2.Cells(36, 9) = "=RAND()"
Else
Sheet2.Cells(36, 9) = ""
End If


'Left
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(13, b + 1) = row3
Sheet2.Cells(14, b + 1) = column3 - (b - 1)
If (Sheet2.Cells(13, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(13, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(9, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 - length > 0 And checker = True Then
Sheet2.Cells(37, 9) = "=RAND()"
Else
Sheet2.Cells(37, 9) = ""
End If


'Right
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(13, b + 1) = row3
Sheet2.Cells(14, b + 1) = column3 + (b - 1)
If (Sheet2.Cells(13, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(13, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(14, b + 1) = Sheet2.Cells(9, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 + length <= 10 And checker = True Then
Sheet2.Cells(38, 9) = "=RAND()"
Else
Sheet2.Cells(38, 9) = ""
End If


Loop Until Sheet2.Cells(38, 6) <> ""


'AIDirection


Sheet2.Cells(11, 4) = Sheet2.Cells(38, 6)
AIDirection = Sheet2.Cells(11, 4)
x = 0
If AIDirection = "Up" Then
For x = 1 To length
Sheet2.Cells(13, 2 + x) = row3 - x
Sheet2.Cells(14, 2 + x) = column3
Next x


ElseIf AIDirection = "Down" Then
For x = 1 To length
Sheet2.Cells(13, 2 + x) = row3 + x
Sheet2.Cells(14, 2 + x) = column3
Next x


ElseIf AIDirection = "Left" Then
For x = 1 To length
Sheet2.Cells(13, 2 + x) = row3
Sheet2.Cells(14, 2 + x) = column3 - x
Next x


ElseIf AIDirection = "Right" Then
For x = 1 To length
Sheet2.Cells(13, 2 + x) = row3
Sheet2.Cells(14, 2 + x) = column3 + x
Next x


End If




'SUBMARINE
length = 2


Do
row3 = Sheet2.Cells(40, 6)
column3 = Sheet2.Cells(40, 6)


Sheet2.Cells(18, 2) = row3
Sheet2.Cells(19, 2) = column3


row3 = Sheet2.Cells(18, 2)
column3 = Sheet2.Cells(19, 2)


'Up
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(18, b + 1) = row3 - (b - 1)
Sheet2.Cells(19, b + 1) = column3
If (Sheet2.Cells(18, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(14, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 - length > 0 And checker = True Then
Sheet2.Cells(39, 9) = "=RAND()"
Else
Sheet2.Cells(39, 9) = ""
End If


'Down
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(18, b + 1) = row3 + (b - 1)
Sheet2.Cells(19, b + 1) = column3
If (Sheet2.Cells(18, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(14, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 + length <= 10 And checker = True Then
Sheet2.Cells(40, 9) = "=RAND()"
Else
Sheet2.Cells(40, 9) = ""
End If


'Left
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(18, b + 1) = row3
Sheet2.Cells(19, b + 1) = column3 - (b - 1)
If (Sheet2.Cells(18, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(14, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 - length > 0 And checker = True Then
Sheet2.Cells(41, 9) = "=RAND()"
Else
Sheet2.Cells(41, 9) = ""
End If


'Right
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(18, b + 1) = row3
Sheet2.Cells(19, b + 1) = column3 + (b - 1)
If (Sheet2.Cells(18, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(18, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(19, b + 1) = Sheet2.Cells(14, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 + length <= 10 And checker = True Then
Sheet2.Cells(42, 9) = "=RAND()"
Else
Sheet2.Cells(42, 9) = ""
End If


Loop Until Sheet2.Cells(42, 6) <> ""


'AIDirection


Sheet2.Cells(16, 4) = Sheet2.Cells(42, 6)
AIDirection = Sheet2.Cells(16, 4)
x = 0
If AIDirection = "Up" Then
For x = 1 To length
Sheet2.Cells(18, 2 + x) = row3 - x
Sheet2.Cells(19, 2 + x) = column3
Next x


ElseIf AIDirection = "Down" Then
For x = 1 To length
Sheet2.Cells(18, 2 + x) = row3 + x
Sheet2.Cells(19, 2 + x) = column3
Next x


ElseIf AIDirection = "Left" Then
For x = 1 To length
Sheet2.Cells(18, 2 + x) = row3
Sheet2.Cells(19, 2 + x) = column3 - x
Next x


ElseIf AIDirection = "Right" Then
For x = 1 To length
Sheet2.Cells(18, 2 + x) = row3
Sheet2.Cells(19, 2 + x) = column3 + x
Next x


End If




'CORVETTE
length = 1


Do
row3 = Sheet2.Cells(44, 6)
column3 = Sheet2.Cells(44, 6)


Sheet2.Cells(23, 2) = row3
Sheet2.Cells(24, 2) = column3


row3 = Sheet2.Cells(23, 2)
column3 = Sheet2.Cells(24, 2)


'Up
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(23, b + 1) = row3 - (b - 1)
Sheet2.Cells(24, b + 1) = column3
If (Sheet2.Cells(23, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(14, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(18, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(19, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 - length > 0 And checker = True Then
Sheet2.Cells(43, 9) = "=RAND()"
Else
Sheet2.Cells(43, 9) = ""
End If


'Down
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(23, b + 1) = row3 + (b - 1)
Sheet2.Cells(24, b + 1) = column3
If (Sheet2.Cells(23, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(14, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(18, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(19, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 + length <= 10 And checker = True Then
Sheet2.Cells(44, 9) = "=RAND()"
Else
Sheet2.Cells(44, 9) = ""
End If


'Left
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(23, b + 1) = row3
Sheet2.Cells(24, b + 1) = column3 - (b - 1)
If (Sheet2.Cells(23, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(14, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(18, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(19, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 - length > 0 And checker = True Then
Sheet2.Cells(45, 9) = "=RAND()"
Else
Sheet2.Cells(45, 9) = ""
End If


'Right
For a = 1 To length + 2
For b = 1 To length
Sheet2.Cells(23, b + 1) = row3
Sheet2.Cells(24, b + 1) = column3 + (b - 1)
If (Sheet2.Cells(23, b + 1) = Sheet2.Cells(3, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(4, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(8, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(9, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(13, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(14, a + 1)) Or (Sheet2.Cells(23, b + 1) = Sheet2.Cells(18, a + 1) And Sheet2.Cells(24, b + 1) = Sheet2.Cells(19, a + 1)) Then
checker = False
Else
checker = True
End If
If checker = False Then Exit For
Next b
If checker = False Then Exit For
Next a


If row3 + length <= 10 And checker = True Then
Sheet2.Cells(46, 9) = "=RAND()"
Else
Sheet2.Cells(46, 9) = ""
End If


Loop Until Sheet2.Cells(46, 6) <> ""


'AIDirection


Sheet2.Cells(21, 4) = Sheet2.Cells(46, 6)
AIDirection = Sheet2.Cells(21, 4)
x = 0
If AIDirection = "Up" Then
For x = 1 To length
Sheet2.Cells(23, 2 + x) = row3 - x
Sheet2.Cells(24, 2 + x) = column3
Next x


ElseIf AIDirection = "Down" Then
For x = 1 To length
Sheet2.Cells(23, 2 + x) = row3 + x
Sheet2.Cells(24, 2 + x) = column3
Next x


ElseIf AIDirection = "Left" Then
For x = 1 To length
Sheet2.Cells(23, 2 + x) = row3
Sheet2.Cells(24, 2 + x) = column3 - x
Next x


ElseIf AIDirection = "Right" Then
For x = 1 To length
Sheet2.Cells(23, 2 + x) = row3
Sheet2.Cells(24, 2 + x) = column3 + x
Next x


End If


row = 8
column = 23


'AIRCRAFT CARRIER
x = 0
row2 = Sheet2.Cells(3, 2) + row
column2 = Sheet2.Cells(4, 2) + column
AIDirection = Sheet2.Cells(1, 4)
Do Until x = 5
x = x + 1
If AIDirection = "Up" Then
Sheet2.Cells(row2 + 1 - x, column2) = "A"
ElseIf AIDirection = "Down" Then
Sheet2.Cells(row2 - 1 + x, column2) = "A"
ElseIf AIDirection = "Left" Then
Sheet2.Cells(row2, column2 + 1 - x) = "A"
Else
Sheet2.Cells(row2, column2 - 1 + x) = "A"
End If
Loop


'BATTLE CRUISER
x = 0
row2 = Sheet2.Cells(8, 2) + row
column2 = Sheet2.Cells(9, 2) + column
AIDirection = Sheet2.Cells(6, 4)
Do Until x = 4
x = x + 1
If AIDirection = "Up" Then
Sheet2.Cells(row2 + 1 - x, column2) = "B"
ElseIf AIDirection = "Down" Then
Sheet2.Cells(row2 - 1 + x, column2) = "B"
ElseIf AIDirection = "Left" Then
Sheet2.Cells(row2, column2 + 1 - x) = "B"
Else
Sheet2.Cells(row2, column2 - 1 + x) = "B"
End If
Loop


'FRIGATE
x = 0
row2 = Sheet2.Cells(13, 2) + row
column2 = Sheet2.Cells(14, 2) + column
AIDirection = Sheet2.Cells(11, 4)
Do Until x = 3
x = x + 1
If AIDirection = "Up" Then
Sheet2.Cells(row2 + 1 - x, column2) = "F"
ElseIf AIDirection = "Down" Then
Sheet2.Cells(row2 - 1 + x, column2) = "F"
ElseIf AIDirection = "Left" Then
Sheet2.Cells(row2, column2 + 1 - x) = "F"
Else
Sheet2.Cells(row2, column2 - 1 + x) = "F"
End If
Loop


'SUBMARINE
x = 0
row2 = Sheet2.Cells(18, 2) + row
column2 = Sheet2.Cells(19, 2) + column
AIDirection = Sheet2.Cells(16, 4)
Do Until x = 3
x = x + 1
If AIDirection = "Up" Then
Sheet2.Cells(row2 + 1 - x, column2) = "S"
ElseIf AIDirection = "Down" Then
Sheet2.Cells(row2 - 1 + x, column2) = "S"
ElseIf AIDirection = "Left" Then
Sheet2.Cells(row2, column2 + 1 - x) = "S"
Else
Sheet2.Cells(row2, column2 - 1 + x) = "S"
End If
Loop


'CORVETTE
x = 0
row2 = Sheet2.Cells(23, 2) + row
column2 = Sheet2.Cells(24, 2) + column
AIDirection = Sheet2.Cells(21, 4)
Do Until x = 2
x = x + 1
If AIDirection = "Up" Then
Sheet2.Cells(row2 + 1 - x, column2) = "C"
ElseIf AIDirection = "Down" Then
Sheet2.Cells(row2 - 1 + x, column2) = "C"
ElseIf AIDirection = "Left" Then
Sheet2.Cells(row2, column2 + 1 - x) = "C"
Else
Sheet2.Cells(row2, column2 - 1 + x) = "C"
End If
Loop


x = 0
y = 0


numoftiles = 0
For x = 9 To 18
For y = 24 To 33
If Sheet2.Cells(x, y) <> "" Then numoftiles = numoftiles + 1
Next y
Next x


Loop Until numoftiles = 17
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
The code is very inefficient. For example, this does 100 writes to the worksheet:

Code: 
        For x = 9 To 18
            For y = 24 To 33
                Sheet2.Cells(x, y) = ""
            Next y
        Next x

This does one:

Code: 
        Sheet2.Range("X9:AG18").ClearContents

Whatever you're doing throughout the code could be done in arrays in memory and then written to the sheet once.
 
Upvote 0
Thank you for the quick reply! I'm fairly new to VBA so I don't know much yet. Can you give me more advice on arrays?
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Pairwise Comparison Table
Replies
4
Views
341
Samgraphics
S
C
  • Question Question
Combining rows 3 through 7 into row 2, one row takes a painfully long time with this code. Why?
Replies
2
Views
233
jolivanes
jolivanes
T
  • Question Question
This is so slow I have to run it overnight
Replies
4
Views
425
kevin9999
K
K
  • Question Question
vba code for unlocking cell after paste
Replies
1
Views
270
MikeVol
MikeVol
K
  • Question Question
How to shorten vba code without any problems
Replies
1
Views
262
kamranyd
K

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

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