Apply case to named range

[Sumeluar]

Hello all - I've looking al over for a solution to my dilemma at no avail. After extensive Google search I found the below code which is applying Case to anything on column "C" which is not ideal for my need, the question is: Can I get someone's help to modify the code that only applies to Named Ranges "Sub_Task_1", "Sub_Task_2", "Sub_Task_3" and "Sub_Task_4"? Those four ranges are all on column "C".



Sub Indentation()

Dim ws As Worksheet
Dim i As Long
Dim lastrow As Long
Set ws = Worksheets("2022")
lastrow = ws.Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To lastrow
Select Case ws.Range("C" & i).IndentLevel

Case 0
ws.Range("C" & i).Font.Bold = False
ws.Range("C" & i).Font.ColorIndex = 1
ws.Range("C" & i).Interior.Color = RGB(255, 255, 255)

Case 1
ws.Range("C" & i).Font.ColorIndex = 3
ws.Range("C" & i).Font.Bold = True
ws.Range("C" & i).Interior.Color = RGB(221, 235, 247)

Case 2
ws.Range("C" & i).Font.ColorIndex = 5
ws.Range("C" & i).Font.Bold = False
ws.Range("C" & i).Interior.Color = RGB(242, 242, 242)

Case 3
ws.Range("C" & i).Font.ColorIndex = 7
ws.Range("C" & i).Font.Bold = False

Case 4
ws.Range("C" & i).Font.ColorIndex = 4
ws.Range("C" & i).Font.Bold = False

End Select
Next
End Sub

Thank you!
Any assistance is greatly appreciated.

 

[dmt32]

Hi,
untested but see if this update to your code will do what you want

Sub Indentation()
    Dim rng As Range, cell As Range
    Dim i   As Long, indent As Long
   
    Set rng = Range("Sub_Task_1,Sub_Task_2,Sub_Task_3,Sub_Task_4")
   
    For i = 1 To rng.Areas.Count
      For Each cell In rng.Areas(i).Cells
       indent = cell.IndentLevel
       indent = IIf(indent > 4, 4, indent) + 1
        With cell
            .Font.Bold = Choose(indent, True, False, False, False)
            .Font.ColorIndex = Choose(indent, 1, 3, 5, 7, 4)
            .Interior.Color = Choose(indent, RGB(221, 235, 247), RGB(221, 235, 247), RGB(242, 242, 242), _
                                             RGB(221, 235, 247), RGB(221, 235, 247))
        End With
      Next cell
    Next i
   
End Sub

Adjust code as required to meet specific project need

Dave

 

[rlv01]

Maybe something like this (not tested).

Sub Indentation()

    Dim ws As Worksheet
    Dim TestRange As Range, R As Range

    Set ws = Worksheets("2022")

    Set TestRange = Application.Union(ws.Range("Sub_Task_1"), ws.Range("Sub_Task_2"), ws.Range("Sub_Task_3"), ws.Range("Sub_Task_4"))
    Debug.Print "Test Range: " & TestRange.Address
    For Each R In TestRange
        Debug.Print R.Address
            Select Case R.IndentLevel

            Case 0
                R.Font.Bold = False
                R.Font.ColorIndex = 1
                R.Interior.Color = RGB(255, 255, 255)

            Case 1
                R.Font.ColorIndex = 3
                R.Font.Bold = True
                R.Interior.Color = RGB(221, 235, 247)

            Case 2
                R.Font.ColorIndex = 5
                R.Font.Bold = False
                R.Interior.Color = RGB(242, 242, 242)

            Case 3
                R.Font.ColorIndex = 7
                R.Font.Bold = False

            Case 4
                R.Font.ColorIndex = 4
                R.Font.Bold = False
            End Select
    Next R
End Sub

(Tip: when posting code, please try to use 'code tags' to format the code as I have done above

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

as it makes the code easier to read.)

 

[Sumeluar]

Hi,
untested but see if this update to your code will do what you want

Sub Indentation()
    Dim rng As Range, cell As Range
    Dim i   As Long, indent As Long
  
    Set rng = Range("Sub_Task_1,Sub_Task_2,Sub_Task_3,Sub_Task_4")
  
    For i = 1 To rng.Areas.Count
      For Each cell In rng.Areas(i).Cells
       indent = cell.IndentLevel
       indent = IIf(indent > 4, 4, indent) + 1
        With cell
            .Font.Bold = Choose(indent, True, False, False, False)
            .Font.ColorIndex = Choose(indent, 1, 3, 5, 7, 4)
            .Interior.Color = Choose(indent, RGB(221, 235, 247), RGB(221, 235, 247), RGB(242, 242, 242), _
                                             RGB(221, 235, 247), RGB(221, 235, 247))
        End With
      Next cell
    Next i
  
End Sub

Adjust code as required to meet specific project need

Dave

Dave - Thank you for the code, it works good.

 

[Sumeluar]

Maybe something like this (not tested).

Sub Indentation()

    Dim ws As Worksheet
    Dim TestRange As Range, R As Range

    Set ws = Worksheets("2022")

    Set TestRange = Application.Union(ws.Range("Sub_Task_1"), ws.Range("Sub_Task_2"), ws.Range("Sub_Task_3"), ws.Range("Sub_Task_4"))
    Debug.Print "Test Range: " & TestRange.Address
    For Each R In TestRange
        Debug.Print R.Address
            Select Case R.IndentLevel

            Case 0
                R.Font.Bold = False
                R.Font.ColorIndex = 1
                R.Interior.Color = RGB(255, 255, 255)

            Case 1
                R.Font.ColorIndex = 3
                R.Font.Bold = True
                R.Interior.Color = RGB(221, 235, 247)

            Case 2
                R.Font.ColorIndex = 5
                R.Font.Bold = False
                R.Interior.Color = RGB(242, 242, 242)

            Case 3
                R.Font.ColorIndex = 7
                R.Font.Bold = False

            Case 4
                R.Font.ColorIndex = 4
                R.Font.Bold = False
            End Select
    Next R
End Sub

(Tip: when posting code, please try to use 'code tags' to format the code as I have done above

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

as it makes the code easier to read.)

rlv01 - That is exactly what I was looking for, it works like a charm, thank you!