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

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
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

T
  • Question
This is so slow I have to run it overnight
Replies
4
Views
242
kevin9999
K
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
204
bobaol
B
G
  • Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
276
GardianAngelUK
G
C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
L
  • Question
Multiselect ListBox for 2 column using Excel VBA
2
Replies
10
Views
693
liaaa
L

Forum statistics

Threads
1,214,832
Messages
6,121,854
Members
449,051
Latest member
excelquestion515

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