Change Tab Color Based on Criteria 1

[shelby55]

Hello

I am using Excel 2010.

I have code that Skip helped me with that takes from one worksheet and creates one worksheet per line of data on another worksheet. This works excellently:

Sub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet

If worksheetexists("1") Then
MsgBox "Abstracts have already been created"

Else

Application.EnableEvents = False

With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("CaseNo")

If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))


Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
wsAdd.Tab _
.Color = 49407

For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Next t
wsAdd.Range("A5:K34,B36:P60,B73:R92").HorizontalAlignment = xlLeft
wsAdd.Range("A5:K34,B36:P60,B73:R92").VerticalAlignment = xlTop


Next

End If
End With

End If
Application.EnableEvents = True

End Sub

Using the Worksheet_Change(ByVal Target As Range) I already have it that this status can change and the tab color changes accordingly but I'd like to flag certain cases right from the start with different tab colors and wonder if this is possible.

Thanks.

 

[Andrzejek]

Did you try something like:

...
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
[blue]
Select Case SomethingHere
  Case "Boston"
    wsAdd.Tab.Color = 49555
  Case "L.A."
    wsAdd.Tab.Color = 49888
  Case Else
    wsAdd.Tab.Color = 49407
End Select
[/blue]
For Each t In [From]
...

Is that what you had in mind?

Have fun.

---- Andy

 

[shelby55]

Hi Andy

This is totally what I had in mind, thanks. The problem is that the "select case" criteria isn't known until the data is pasted.

I tried:

If Target.Address = "$E$119" Then
Select Case Target.Value
             Case "Complete - Changes"
             wsAdd.Tab.Color = 14329708
             Case "Follow up required"
             wsAdd.Tab.Color = 255
             Case "Complete - No Changes"
             wsAdd.Tab.Color = 24576
             Case "Not reabstracted"
             wsAdd.Tab.Color = 49407
             End Select
             End If

where you suggested pasting it but can it go further down in the code? Or can I reference what column on the raw data sheet that this information is? Or use a named range for it?

Thanks for any further assistance you can give.

 

[Andrzejek]

I would do it here, you should have your data by this point:

...
Next

End If
End With

[blue]
If Target.Address = "$E$119" Then
  Select Case Target.Value
    Case "Complete - Changes"
      wsAdd.Tab.Color = 14329708
    Case "Follow up required"
      wsAdd.Tab.Color = 255
    Case "Complete - No Changes"
      wsAdd.Tab.Color = 24576
    Case "Not reabstracted"
      wsAdd.Tab.Color = 49407
    Case Else
      ....
  End Select
End If 
[/blue]
End If
Application.EnableEvents = True

End Sub

Have fun.

---- Andy

 

[shelby55]

Thanks Andy

Unfortunately this causes a runtime error-424 - object required.

Interestingly, it copied all of the worksheets (10) without incident until the last one where the error above occurred. Also interestingly, it didn't change any of the tabs based on the values in those fields.

Any other ideas? Thanks very much.

 

[Andrzejek]

Which line of code causes the error?

Have fun.

---- Andy

 

[Andrzejek]

You may want to try to move the (blue) code before the [tt] Next[/tt] and see if that's going to work.

Have fun.

---- Andy

 

[shelby55]

Hi Andy

That doesn't work either....any other suggestions? Thanks.

 

[Andrzejek]

I still don't know which line of code is the problem... But since it still does not work, then it does not metter much... :-(

When you step thru your code, at which point do you want to assign the color to the tab?
Whene is the point where you have all the information ready to do so?

Have fun.

---- Andy

 

[shelby55]

Hi

Thanks for sticking with me. The first line of code "If Target.Address = "$E$119" Then" is the problem and it won't go beyond that.

When I run the code it keeps repeating the area between

For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Next t

so I assume that is where I need it to go...but I get the same error message and it stops at the same line of code. The target field in question is the final one per the copied worksheet but I don't know if that matters.

 

[shelby55]

HI

Okay, I figured it out. I set the value of the target field when the wsadd was set to active worksheet i.e. Set targcell = wsAdd.Cells(119, 5)

Then I added the code before the line of "next t":

Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
Set targcell = wsAdd.Cells(119, 5)

wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value

For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Select Case targcell.Value
    Case "Complete - Changes"
        wsAdd.Tab.Color = 16711680
            'blue
    Case "Follow up required"
        wsAdd.Tab.Color = 204
             'red
     Case "Complete - No Changes"
        wsAdd.Tab.Color = 26112
             'green
     Case "Not reabstracted"
        wsAdd.Tab.Color = 10498160
             'purple
     Case "Optional Changes - FYI"
        wsAdd.Tab.Color = 5296274
     End Select[/color]
     
Next t

Thanks for your help!