line connecting one cell to another

[jammoca]

Ok ... I have a code that looks inside a range of cells to find cells whose font has been conditionally formatted to change to either red or black.

Sub Test()
Dim Sh As Worksheet
Dim rng As Range
Dim Ln As Line
Dim r As Integer
Dim c As Integer
Dim Begx1 As Single, Begy1 As Single, Endx1 As Single, Endy1 As Single
Dim Begx2 As Single, Begy2 As Single, Endx2 As Single, Endy2 As Single
Dim Shp As Shape
Set Sh = Worksheets("Indiv Profile")
For Each Ln In Sh.Lines
Ln.Delete
Next Ln
Set rng = Sh.Range("E39:W53")
With rng
For c = 1 To .Columns.Count
For r = 1 To .Rows.Count
If CFColorindex(.Cells(r, c)) = 3 Then
With .Cells(r, c)
Begx1 = .Left + .Width / 2
Begy1 = .Top + .Height / 2
End With
ElseIf CFColorindex(.Cells(r, c)) = 1 Then
With .Cells(r, c)
Begx2 = .Left + .Width / 2
Begy2 = .Top + .Height / 2
End With
End If
If CFColorindex(.Cells(r, c + 1)) = 3 Then
With .Cells(r, c + 1)
Endx1 = .Left + .Width / 2
Endy1 = .Top + .Height / 2
End With
ElseIf CFColorindex(.Cells(r, c + 1)) = 1 Then
With .Cells(r, c + 1)
Endx2 = .Left + .Width / 2
Endy2 = .Top + .Height / 2
End With
End If
Next r
Set Shp = Sh.Shapes.AddLine(Begx1, Begy1, Endx1, Endy1)
With Shp.Line
.Weight = 1.5
.ForeColor.SchemeColor = 10
End With
Set Shp = Sh.Shapes.AddLine(Begx2, Begy2, Endx2, Endy2)
With Shp.Line
.Weight = 1.5
.ForeColor.SchemeColor = 8
End With
Next c
End With
End Sub
Public Function CFColorindex(rng As Range, _
Optional text As Boolean = False)
'---------------------------------------------------------------------
Dim oFC As FormatCondition
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long

Set rng = rng(1, 1)
If rng.FormatConditions.Count > 0 Then
For Each oFC In rng.FormatConditions
If oFC.Type = xlCellValue Then
Select Case oFC.Operator
Case xlEqual
CFColorindex = rng.Value = oFC.Formula1
Case xlNotEqual
CFColorindex = rng.Value <> oFC.Formula1
Case xlGreater
CFColorindex = rng.Value > oFC.Formula1
Case xlGreaterEqual
CFColorindex = rng.Value >= oFC.Formula1
Case xlLess
CFColorindex = rng.Value < oFC.Formula1
Case xlLessEqual
CFColorindex = rng.Value <= oFC.Formula1
Case xlBetween
CFColorindex = (rng.Value >= oFC.Formula1 And _
rng.Value <= oFC.Formula2)
Case xlNotBetween
CFColorindex = (rng.Value < oFC.Formula1 Or _
rng.Value > oFC.Formula2)
End Select
Else
're-adjust the formula back to the formula that applies
'to the cell as relative formulae adjust to the activecell
With Application
iRow = rng.Row
iColumn = rng.Column
sF1 = .Substitute(oFC.Formula1, "ROW()", iRow)
sF1 = .Substitute(sF1, "COLUMN()", iColumn)
sF1 = .ConvertFormula(sF1, xlA1, xlR1C1)
sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
End With
CFColorindex = rng.Parent.Evaluate(sF1)
End If

If CFColorindex Then
If text Then
If Not IsNull(oFC.Font.ColorIndex) Then
CFColorindex = oFC.Font.ColorIndex
End If
End If
Exit Function
End If
Next oFC
End If 'rng.FormatConditions.Count > 0

End Function


The code then is supposed to draw a red line from the first cell whose font has been changed to red to the second, and from second to third etc etc etc. There will only be one conditionally altered cell per column within the range.

The code also is supposed to draw a black line from the first cell whose font has been changed to black to the second, and from second to third etc etc etc. Again, there will only be one conditionally altered cell per column within the range.

However, I'm getting the debug message .... run-time error '13' Type mismatch ..... on the following line :

If CFColorindex Then

This is about the 9th bottom line in the code.

Hence, it is not creating any lines between the cells whose font has been changed to red, nor those that have been changed to black.

Any suggestions would be greatly appreciated

 

[jammoca]

.

 

[jammoca]

.