Haley,

I modified your original code to do this for you. I have not been able to test it yet with actual data, though.

Ben

Sub findoutlier()
Dim strCell As String
Dim strRange As String
Dim x As Long
Dim rRange As Range


For x = 0 To 29
'Assumes that each column has the same number of rows
Set rRange = Range("A1:A43").Offset(0, x)
strCell = "$" & Replace(rRange.Range("A1").Address, "$", vbNullString, 1)
strRange = Replace(rRange.Address, "$", vbNullString, 1)
Debug.Print strCell & vbCr & strRange

With rRange
.Select
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(" & strCell & " < ""."", OR(" & _
strCell & "<(QUARTILE(" & strRange & ", 1)-1.5*(QUARTILE(" & _
strRange & ", 3)-QUARTILE(" & strRange & ", 1))), " & _
strCell & "(QUARTILE(" & strRange & ", 1)+1.5*(QUARTILE(" & _
strRange & ", 3)-QUARTILE(" & strRange & ", 1)))))"
.FormatConditions(.FormatConditions.Count).SetFirs tPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Next x

End Sub