SOLVED
Home

Needs Help with Some Editing of A Code

Contributor

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

 

5 Replies
Highlighted

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 Sub

 

The 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 Sub

 

Regards

Haytham

Highlighted

@Haytham Amairah Hi I am actually wanting to convert it into a case select version of this code

Highlighted

@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 <> 0

Dim RowRange, ColRange
RowRange = 20
ColRange = 20

Select Case Cells(Row, Col)


Case i
Cells(Row, Col).Interior.Color = vbWhite
Case j
Cells(Row, Col).Interior.Color = vbYellow
End Select

Col = Col + 1
Loop

Row = Row + 1
Loop

End Sub

 

 

Highlighted
Solution

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

 

Highlighted

@Haytham Amairah Alright, thank you very much! :)