populate cell on worksheet 2 if text is red on worksheet 1

S

SCrowley

I have the 2007 calendar (jan - dec) on one worksheet (master worksheet). The
text is colored depending on the team it applies to. Copied worksheet 1 to
become Worksheet 2, 3 and 4 (one for each team). Here is the ideal solution:

Worksheet 2 (team 1) If cells C5:H110 on Worksheet 1 contain text that is
RED, populate C5:H110 on Worksheet 2 with only RED text. Worksheet 3 (team 2)
If cells C5:H110 on Worksheet 1 contain text that is GREEN, populate C5:H110
on Worksheet 3 with only GREEN text. Worksheet 4 (team 3) If cells C5:H110 on
Worksheet 1 contain text that is BLUE, populate C5:H110 on Worksheet 4 with
only RED text.
 
B

Bernie Deitrick

S,

The general strategy would be to use a macro - you will need to figure out the correct colorindices
to use. (Hint: use the macro recorder while applying the font colors...)

Sub CalColors()
Dim myCell As Range

Worksheets("Sheet1").Range("C5:H110").ClearContents
Worksheets("Sheet2").Range("C5:H110").ClearContents
Worksheets("Sheet3").Range("C5:H110").ClearContents
Worksheets("Sheet4").Range("C5:H110").ClearContents

For Each myCell In Worksheets("Master").Range("C5:H110")
If myCell.Font.ColorIndex = 3 Then
Worksheets("Sheet1").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 6 Then
Worksheets("Sheet2").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 8 Then
Worksheets("Sheet3").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 10 Then
Worksheets("Sheet4").Range(myCell.Address).Value = myCell.Value
End If
Next myCell

End Sub
 
S

SCrowley

Bernie - You saved my life!!!

This works perfectly. I commented out the ClearContents lines due to they
are already populated and I don't want to lose the data. Here is how my final
code looks:

Sub CalColors()
Dim myCell As Range

'Worksheets("2007 Calendar").Range("B5:H110").ClearContents
'Worksheets("Retail").Range("B5:H110").ClearContents
'Worksheets("Workplace").Range("B5:H110").ClearContents
'Worksheets("Community").Range("B5:H110").ClearContents

For Each myCell In Worksheets("2007 Calendar").Range("B5:H110")
'If myCell.Font.ColorIndex = 3 Then
'Worksheets("2007 Calendar").Range(myCell.Address).Value =
myCell.Value
'End If
If myCell.Font.ColorIndex = 3 Then
Worksheets("Retail").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 5 Then
Worksheets("Workplace").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 10 Then
Worksheets("Community").Range(myCell.Address).Value = myCell.Value
End If
Next myCell

End Sub


--
Thank you,

scrowley(AT)littleonline.com


Bernie Deitrick said:
S,

The general strategy would be to use a macro - you will need to figure out the correct colorindices
to use. (Hint: use the macro recorder while applying the font colors...)

Sub CalColors()
Dim myCell As Range

Worksheets("Sheet1").Range("C5:H110").ClearContents
Worksheets("Sheet2").Range("C5:H110").ClearContents
Worksheets("Sheet3").Range("C5:H110").ClearContents
Worksheets("Sheet4").Range("C5:H110").ClearContents

For Each myCell In Worksheets("Master").Range("C5:H110")
If myCell.Font.ColorIndex = 3 Then
Worksheets("Sheet1").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 6 Then
Worksheets("Sheet2").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 8 Then
Worksheets("Sheet3").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 10 Then
Worksheets("Sheet4").Range(myCell.Address).Value = myCell.Value
End If
Next myCell

End Sub
Click to expand...
 
S

SCrowley

Bernie,

You saved my life! This works beautifully. I made a couple of modifications
to fit my needs:

Sub CalColors()
Dim myCell As Range

' Worksheets("2007 Calendar").Range("B5:H110").ClearContents
' Worksheets("Retail").Range("B5:H110").ClearContents
' Worksheets("Workplace").Range("B5:H110").ClearContents
' Worksheets("Community").Range("B5:H110").ClearContents

For Each myCell In Worksheets("2007 Calendar").Range("B5:H110")
If myCell.Font.ColorIndex = 3 Then
Worksheets("Retail").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 5 Then
Worksheets("Workplace").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 10 Then
Worksheets("Community").Range(myCell.Address).Value = myCell.Value
End If
Next myCell

End Sub
--
Thank you,

scrowley(AT)littleonline.com


Bernie Deitrick said:
S,

The general strategy would be to use a macro - you will need to figure out the correct colorindices
to use. (Hint: use the macro recorder while applying the font colors...)

Sub CalColors()
Dim myCell As Range

Worksheets("Sheet1").Range("C5:H110").ClearContents
Worksheets("Sheet2").Range("C5:H110").ClearContents
Worksheets("Sheet3").Range("C5:H110").ClearContents
Worksheets("Sheet4").Range("C5:H110").ClearContents

For Each myCell In Worksheets("Master").Range("C5:H110")
If myCell.Font.ColorIndex = 3 Then
Worksheets("Sheet1").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 6 Then
Worksheets("Sheet2").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 8 Then
Worksheets("Sheet3").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 10 Then
Worksheets("Sheet4").Range(myCell.Address).Value = myCell.Value
End If
Next myCell

End Sub
Click to expand...
 
S

SCrowley

Bernie,

I passed this on to the end user. Now they want to separate if there are
multiple colors in one cell. Can this same concept apply? If so, how would it
look for multiples?
--
Thank you,

scrowley(AT)littleonline.com


Bernie Deitrick said:
S,

The general strategy would be to use a macro - you will need to figure out the correct colorindices
to use. (Hint: use the macro recorder while applying the font colors...)

Sub CalColors()
Dim myCell As Range

Worksheets("Sheet1").Range("C5:H110").ClearContents
Worksheets("Sheet2").Range("C5:H110").ClearContents
Worksheets("Sheet3").Range("C5:H110").ClearContents
Worksheets("Sheet4").Range("C5:H110").ClearContents

For Each myCell In Worksheets("Master").Range("C5:H110")
If myCell.Font.ColorIndex = 3 Then
Worksheets("Sheet1").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 6 Then
Worksheets("Sheet2").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 8 Then
Worksheets("Sheet3").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Font.ColorIndex = 10 Then
Worksheets("Sheet4").Range(myCell.Address).Value = myCell.Value
End If
Next myCell

End Sub
Click to expand...
 
B

Bernie Deitrick

S,

Try this, which will look at font colors on a letter by letter basis. Note that if the string is
100 characters long, all in color 3, then this will copy the information over 100 times. We could
add controls to only do the copying once if this is really slow..... Also, I wasn't sure what you
meant by 'separate' - do you only want the words that are the specific color??

Sub CalColors2()
Dim myCell As Range
Dim i As Integer

For Each myCell In Worksheets("2007 Calendar").Range("B5:H110")
For i = 1 To Len(myCell.Value)
If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 3 Then
Worksheets("Retail").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 5 Then
Worksheets("Workplace").Range(myCell.Address).Value = myCell.Value
End If
If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 10 Then
Worksheets("Community").Range(myCell.Address).Value = myCell.Value
End If
Next i
Next myCell

End Sub

HTH,
Bernie
MS Excel MVP


SCrowley said:
Bernie,

I passed this on to the end user. Now they want to separate if there are
multiple colors in one cell. Can this same concept apply? If so, how would it
look for multiples?
Click to expand...
 
S

SCrowley

Thank you, Bernie.

I'll try this solution. To answer your question:

Cell B5 has 4 lines:
Ln1 = Washington Post (in RED, hard return to next line);
Ln2 = Chicago Tribune (in GREEN, hard return to next line);
Ln3 = Charlotte Observer (in BLUE, hard return to next line);
Ln4 = Atlanta Constitution (in BLACK)

Each color represents a specific team. The Master Sheet houses all the teams
data and the team sheets represent only the data that corrolates with their
specified colored font.

Does this help?
 
B

Bernie Deitrick

S,

No, it doesn't answer my question. What data should be copied to the other sheets from cell B5?

Option 1: All four lines to all four sheets.

Option 2: Line one to the red sheet, line 2 to the green sheet, etc.

Will all text be colored, or just some words? and what to do with the default text?

HTH,
Bernie
MS Excel MVP
 
S

SCrowley

Option 2: Red line to the Red sheet. Green line to the Green sheet, I have
created a 'black text' sheet (default text) as well see code below.

If myCell.Font.ColorIndex = -4105 Then
Worksheets("Corporate").Range(myCell.Address).Value = myCell.Value
End If

All colored text (strings) will meet one of the criteria. It will be red,
green, blue or black. The text (strings) are usually multiple words and not
separated out by individual letters.
 
B

Bernie Deitrick

S,

Try something like the code below. You need to replace each occurence of Name1, Name2, and Name3 in
the code - I could not figure out your color/name combinations from your reply....

HTH,
Bernie
MS Excel MVP


Sub TryNow()
Dim i As Integer
Dim myCell As Range

Dim Erase1 As Boolean
Dim Erase2 As Boolean
Dim Erase3 As Boolean
Dim Erase4 As Boolean

For Each myCell In Worksheets("2007 Calendar").Range("B5:H110")

Erase1 = True
Erase2 = True
Erase3 = True
Erase4 = True

For i = 1 To Len(myCell.Value)
If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = -4105 Then
If Erase1 Then
Worksheets("Corporate").Range(myCell.Address).ClearContents
Erase1 = False
End If
Worksheets("Corporate").Range(myCell.Address).Value = _
Worksheets("Corporate").Range(myCell.Address).Value & Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 3 Then
If Erase1 Then
Worksheets("Name1").Range(myCell.Address).ClearContents
Erase1 = False
End If
Worksheets("Name1").Range(myCell.Address).Value = _
Worksheets("Name1").Range(myCell.Address).Value & Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 50 Then
If Erase2 Then
Worksheets("Name2").Range(myCell.Address).ClearContents
Erase2 = False
End If
Worksheets("Name2").Range(myCell.Address).Value = _
Worksheets("Name2").Range(myCell.Address).Value & Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 41 Then
If Erase3 Then
Worksheets("Name3").Range(myCell.Address).ClearContents
Erase3 = False
End If
Worksheets("Name3").Range(myCell.Address).Value = _
Worksheets("Name3").Range(myCell.Address).Value & Mid(myCell.Value, i, 1)
End If

Next i
Next myCell

End Sub
 
S

SCrowley

Thank you Bernie. Sorry I wasn't clear.

Below is the code with the correct sheet/color combination. I have run it
and received a "Run-time error '9': Subscript out of range"

I've looked at the help feature for this error and it is beyond the scope of
my knowledge. Is the subscript the Erase1/2/3/4 statements? Have I forgotten
to modify one of the words?

Sub UpdateWorksheets()
Dim i As Integer
Dim myCell As Range

Dim Erase1 As Boolean
Dim Erase2 As Boolean
Dim Erase3 As Boolean
Dim Erase4 As Boolean

Erase1 = True
Erase2 = True
Erase3 = True
Erase4 = True

For Each myCell In Worksheets("2007 Calendar").Range("B5:H110")

For i = 1 To Len(myCell.Value)
If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = -4105 Then
If Erase1 Then
Worksheets("Corporate").Range(myCell.Address).ClearContents
Erase1 = False
End If
Worksheets("Corporate").Range(myCell.Address).Value = _
Worksheets("Corporate").Range(myCell.Address).Value &
Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 3 Then
If Erase1 Then
Worksheets("Retail").Range(myCell.Address).ClearContents
Erase1 = False
End If
Worksheets("Retail").Range(myCell.Address).Value = _
Worksheets("Retail").Range(myCell.Address).Value & Mid(myCell.Value,
i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 50 Then
If Erase2 Then
Worksheets("Community").Range(myCell.Address).ClearContents
Erase2 = False
End If
Worksheets("Community").Range(myCell.Address).Value = _
Worksheets("Community").Range(myCell.Address).Value &
Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 41 Then
If Erase3 Then
Worksheets("Workplace").Range(myCell.Address).ClearContents
Erase3 = False
End If
Worksheets("Workplace").Range(myCell.Address).Value = _
Worksheets("Workplace").Range(myCell.Address).Value &
Mid(myCell.Value, i, 1)
End If

Next i
Next myCell

End Sub
 
B

Bernie Deitrick

Below is the code with the correct sheet/color combination. I have run it
and received a "Run-time error '9': Subscript out of range"
Click to expand...

Your code looks fine, and ran for me without an error. What line does the error occur on? That
kind of error usually means that you're not matching the exact sheet name with the string that
you've typed into code.

HTH,
Bernie
MS Excel MVP
 
S

SCrowley

Thank you, Bernie.

You're awesome! I was using the wrong sheet1 name. I appreciate your help
more than you know.
 
B

Bernie Deitrick

S,

Glad to hear that you got it to work. Is the functionality correct, or does it need to be tweaked?

Bernie
MS Excel MVP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Formula or Conditional Formatting Help needed. 1
change cell color depending on two cell values 1
Multiple Criteria Find & Replace 3
How to count two cells occurrences in a worksheet 3
Excel 2003 Conditional Formatting w/ 3 Conditions and a value = to 2
Use Formula from another worksheet 3
Copy cells in Excel 1
HOW WILL MOVE TO 2ND WORKSHEET 2

Top