Delete the sheets in the current workbook which are not have coloredin the tab

[vicky]

i need a vba code to delete all the sheets whose sheet name are not
coloured .......

 

[Peter T]

Sub DelNonColouredTabs()
Dim i As Long
Dim s As String
Dim shot As Object

If Val(Application.Version) <= 9 Then
MsgBox "Coloured tabs N/A in this Excel version"
Exit Sub
End If

ReDim arrNames(1 To ActiveWorkbook.Sheets.Count)

For Each sht In ActiveWorkbook.Sheets
If VarType(sht.Tab.Color) = vbBoolean Then
i = i + 1
arrNames(i) = sht.Name
End If
Next

If i = ActiveWorkbook.Sheets.Count Then
MsgBox "Cannot delete all sheets in the Workbook"

ElseIf i > 0 Then
ReDim Preserve arrNames(1 To i)
s = arrNames(1)
For i = 2 To UBound(arrNames)
s = s & vbCr & arrNames(i)
Next

If MsgBox("Delete the following Sheets" & vbCr & s, _
vbOKCancel) = vbOK Then
On Error GoTo errH
Application.DisplayAlerts = False
For i = UBound(arrNames) To 1 Step -1
ActiveWorkbook.Sheets(arrNames(i)).Delete
Next
End If
ElseIf i = 0 Then
MsgBox "All sheet tabs are coloured"
End If

done:
Application.DisplayAlerts = True
Exit Sub
errH:
MsgBox Err.Description
Resume done

End Sub

Regards,
Peter T

 

[excelent]

Sub Terminate()
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Sheets
If ws.Tab.ColorIndex = -4142 Then ws.Delete
Next
Application.DisplayAlerts = False
End Sub


"vicky" skrev:

 

[Barb Reinhardt]

Here's some basic code.

You will be asked if you want to delete the worksheets and you'll need to
acknowledge it. If you don't want to do that, put Application.DisplayAlerts
=FALSE and =TRUE around the delete line. Also, if you try to delete the
last sheet, it won't let you. You need to have at least one visible sheet in
the workbook. This should get you started.

Dim WS As Excel.Worksheet

For Each WS In ThisWorkbook.Worksheets
Debug.Print WS.Tab.ColorIndex
If WS.Tab.ColorIndex <> xlColorIndexNone Then
WS.Delete
End If
Next WS