rgr
04-21-2006, 05:55 AM
I have 2 columns of text. The text may have any number of red fonts or black fonts in either column. I would like to take any of the black fonts in column H and swap it with any of the red fonts in column B. Once column H is full of red fonts the procedure should stop. There may be an overabundance of red fonts in B, or, there may be none.
The code I have works only for the 1st instance then fails. I have attached a screen shot. Thank you for your suggestions.
Sub SwapHost()
Dim cel1 As Range
Dim cel2 As Range
Dim rng1 As Range
Dim rng2 As Range
Dim player1 As String
Dim player2 As String
Dim player3 As String
Dim player4 As String
Dim lr As Long
lr = Worksheets("Round 2").Range("B65536").End(xlUp).Row
Set rng1 = Worksheets("Round 2").Range("B5:B36")
Set rng2 = Worksheets("Round 2").Range("H5:H36")
For Each cel1 In rng1
If cel1.Font.ColorIndex = 3 Then
player1 = cel1.Value
For Each cel2 In rng2
If cel2.Font.ColorIndex <> 3 Then
cel2.Value = player1
End If
Next cel2
End If
Next cel1
End Sub
The code I have works only for the 1st instance then fails. I have attached a screen shot. Thank you for your suggestions.
Sub SwapHost()
Dim cel1 As Range
Dim cel2 As Range
Dim rng1 As Range
Dim rng2 As Range
Dim player1 As String
Dim player2 As String
Dim player3 As String
Dim player4 As String
Dim lr As Long
lr = Worksheets("Round 2").Range("B65536").End(xlUp).Row
Set rng1 = Worksheets("Round 2").Range("B5:B36")
Set rng2 = Worksheets("Round 2").Range("H5:H36")
For Each cel1 In rng1
If cel1.Font.ColorIndex = 3 Then
player1 = cel1.Value
For Each cel2 In rng2
If cel2.Font.ColorIndex <> 3 Then
cel2.Value = player1
End If
Next cel2
End If
Next cel1
End Sub