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 =...

Formulas & Functions

VBA

Haytham Amairah

May 18, 2018

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

Silver Contributor

May 18, 2018

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

ONG ZHEN YANG RP

Brass Contributor

May 18, 2018

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

Forum Discussion

Needs Help with Some Editing of A Code

Resources