Forum Discussion
Needs Help with Some Editing of A Code
Help me edit this code to achieve this end result. As much as possible, please keep the format the same for "select case" and "Loop"
Sub QuestionFive()
Dim r, c As Integer
Do While r < 20 r = 1
Do While c < 20 c = 1
Select Case Cells(20, 20)
Case (r + c) Mod 2 Cells(r, c).Interior.Color = RGB(255, 255, 0)
Cells(r, c).Interior.Color = RGB(255, 255, 255)
End Select r = r + 1
Loop c = c + 1
Loop E
nd Sub
Hi ONG,
Using SELECT CASE statement for this purpose is really tricky, but finally, I figure it out!
This is the code:
Sub Chessboard()
Dim r As Integer
Dim c As Integer
r = 1
c = 1
Do While r <= 20 And c <= 20
Dim ir As Boolean
ir = r Mod 2 = 0
Dim ic As Boolean
ic = c Mod 2 = 0
Dim i As Boolean
i = ir = ic
Select Case i
Case True
Cells(r, c).Interior.Color = vbYellow
Case False
Cells(r, c).Interior.Color = vbWhite
End Select
r = r + 1
If r > 20 Then
r = 1
c = c + 1
ElseIf c > 20 Then
Exit Sub
End If
Loop
End Sub
5 Replies
Hi ONG,
Back to you again :)
You can depend on the same code I suggested in the previous conversation, but with some changes, as follows:
Sub ODD_EVEN_IN_Yellow()
'Written by Haytham Amairah
'Created: 18/5/2018
'Last updated: 18/5/2018
'Applied to range (A1:T20)
On Error GoTo Handler
With Application
.ScreenUpdating = False
.EnableAnimations = False
Dim cell As Range
For Each cell In Range("A1:T20")
If cell.Row Mod 2 = 0 And cell.Column Mod 2 = 0 Then
cell.Interior.Color = vbYellow
ElseIf cell.Row Mod 2 <> 0 And cell.Column Mod 2 <> 0 Then
cell.Interior.Color = vbYellow
Else
cell.Value = ""
End If
Next
.ScreenUpdating = True
.EnableAnimations = True
End With
Exit Sub
Handler:
With Application
.ScreenUpdating = True
.EnableAnimations = True
End With
End SubThe above code is applied to a range (A1:T20), but if you want to apply it to a custom range, please change it as follows:
Sub ODD_EVEN_IN_Yellow_2()
'Written by Haytham Amairah
'Created: 18/5/2018
'Last updated: 18/5/2018
'Applied to a custom range
On Error GoTo Handler
Dim appliedRange As Range
Set appliedRange = Application.InputBox("Please select the range:" _
, , , , , , , 8)
With Application
.ScreenUpdating = False
.EnableAnimations = False
Dim cell As Range
For Each cell In appliedRange
If cell.Row Mod 2 = 0 And cell.Column Mod 2 = 0 Then
cell.Interior.Color = vbYellow
ElseIf cell.Row Mod 2 <> 0 And cell.Column Mod 2 <> 0 Then
cell.Interior.Color = vbYellow
Else
cell.Value = ""
End If
Next
.ScreenUpdating = True
.EnableAnimations = True
End With
Exit Sub
Handler:
With Application
.ScreenUpdating = True
.EnableAnimations = True
End With
End SubRegards
Haytham
Haytham Amairah I actually made a new code, can you help me check it
Sub chessboard()
Dim Col, Row As Integer
Col = 1
Do While Col < 21
Row = 1
Do While Row < 21
Dim i As Integer
i = Col Mod 2 = 1
Dim j As Integer
j = Col Mod 2 <> 0Dim RowRange, ColRange
RowRange = 20
ColRange = 20Select Case Cells(Row, Col)
Case i
Cells(Row, Col).Interior.Color = vbWhite
Case j
Cells(Row, Col).Interior.Color = vbYellow
End SelectCol = Col + 1
LoopRow = Row + 1
LoopEnd Sub
Hi ONG,
Using SELECT CASE statement for this purpose is really tricky, but finally, I figure it out!
This is the code:
Sub Chessboard()
Dim r As Integer
Dim c As Integer
r = 1
c = 1
Do While r <= 20 And c <= 20
Dim ir As Boolean
ir = r Mod 2 = 0
Dim ic As Boolean
ic = c Mod 2 = 0
Dim i As Boolean
i = ir = ic
Select Case i
Case True
Cells(r, c).Interior.Color = vbYellow
Case False
Cells(r, c).Interior.Color = vbWhite
End Select
r = r + 1
If r > 20 Then
r = 1
c = c + 1
ElseIf c > 20 Then
Exit Sub
End If
Loop
End Sub
Haytham Amairah Hi I am actually wanting to convert it into a case select version of this code
