"Howard" wrote:
I got this code From Don Guillett Aug 9, 2012
[....]
I have tried to add an additional "Case Is" in the
code to make it produce a space in the "internal"
blanks and ignore the blanks at the end, to no avail.

I do not see "this code" in your posting. And I do not understand most of
your description. But if you are referring to the code posted by Don on Aug
9 at
http://groups.google.com/group/micro...1020225a236fdb
[1], perhaps the following will do what you want.


Sub TheTestSas()
Dim myChar As String
Dim RANGERTEST As Range
Dim v As Variant
Dim i As Long, j As Long, k As Long, n As Long, c As Long
Range("RANGERTEST").Offset(8).ClearContents
myChar = Range("A10")
v = Range("RANGERTEST") ' copy into v(1,1),...,v(n,1)
n = UBound(v, 1)
For i = 1 To n ' delete leading blanks
If Len(Trim(v(i, 1))) 0 Then Exit For
Next
For j = n To 1 Step -1 ' delete trailing blanks
If Len(Trim(v(j, 1))) 0 Then Exit For
Next
If i <= j Then ' else all blank
n = j - i + 1
ReDim res(1 to n, 1 to 1) As Variant
c = 0
For k = i To j ' keep interstitial blanks
c = c + 1
If Len(Trim(v(k, 1))) 0 Then
res(c, 1) = IIf(v(k, 1) = myChar, "O", "X")
End If
Next
Range("RANGERTEST").Offset(8).Resize(1, n) = res
End If
End Sub


-----
[1] Don's original code:

Option Explicit
Option Compare Text
Sub TheTestSas()
Dim J As String
Dim RANGERTEST As Range
Dim C As Range
Application.ScreenUpdating = False
J = Range("A10").Value
Range("RANGERTEST").Offset(8).Value = ""
For Each C In Range("RANGERTEST")
If Len(Application.Trim(C)) 0 Then
Select Case C
Case Is = J: C.Offset(8) = "O"
Case Is < J: C.Offset(8) = "X"
End Select
End If
Next
Application.ScreenUpdating = True
End Sub