CODEWITHSUNDEEP
excelvbacolorstabs
André Larsson
André Larsson

Reputation: 21

VBA, create a new sheet based on a list and give it a color

I have a code that create a new sheet based on a list in one sheet called "Röd". I try to give the new created sheet a color but dosent make anything to work? How do i color a new created sheet with my code?

Sub Röd()

    Dim MyCell As Range, MyRange As Range
    Dim ws As Worksheets
    

    'This Macro will create separate tabs based on a list in Distribution Tab A2 down

    Set MyRange = Sheets("Röd").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    

    Application.DisplayAlerts = False

    For Each MyCell In MyRange
         If SheetCheck(MyCell) = False And MyCell <> "" Then
            Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
            .Color = RGB(255, 0, 0)
            End If
    
    
    Next
    
    Application.DisplayAlerts = True
    
End Sub

Upvotes: 1

Views: 296

Answers (2)

Andr&#233; Larsson
Andr&#233; Larsson

Reputation: 21

Now it works. I didn't write it correctly before.

Sub Röd()
    Dim MyCell As Range, MyRange As Range
    Dim ws As Worksheets
    
    'This Macro will create separate tabs based on a list in Distribution Tab A2 down

    Set MyRange = Sheets("Röd").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    Application.DisplayAlerts = False

    For Each MyCell In MyRange
        If SheetCheck(MyCell) = False And MyCell <> "" Then
            Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Tab.Color = RGB(255, 0, 0) 'give the new tab color red
            Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
        End If
    Next
    
    Application.DisplayAlerts = True
End Sub

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149305

Is this what you are trying?

I have commented the code so you should not have a problem understanding it. If you still have questions then simply ask.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim i As Long
    
    '~~> Set this to the relevant worksheet
    Set ws = Sheets("Röd")
    
    With ws
        '~~> Find last row in Column A
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        '~~> Loop through the range
        For i = 3 To lRow
            '~~> Check if cell is not empty
            If Len(Trim(.Range("A" & i).Value2)) <> 0 Then
                '~~> Check if the sheet already exists
                If SheetCheck(.Range("A" & i)) = False Then
                    With ThisWorkbook
                        '~~> Add the sheet
                        .Sheets.Add After:=.Sheets(.Sheets.Count)
                        '~~> Color the tab
                        .Sheets(.Sheets.Count).Tab.Color = RGB(255, 0, 0)
                        '~~> Name the tab
                        .Sheets(.Sheets.Count).Name = ws.Range("A" & i).Value2
                    End With
                End If
            End If
        Next i
    End With
End Sub

Function SheetCheck(MyCell As Range) As Boolean
    Dim wsht As Worksheet
    
    For Each wsht In ThisWorkbook.Worksheets
        If wsht.Name = MyCell.Value2 Then
            SheetCheck = True
            Exit For
        End If
    Next
End Function

Upvotes: 1

Related Questions