Coloring a text string of an inkEdit control using a Sheet Rowsource as data

[chazrab]

I'm having a hard time making this code do what I want it to. Basically, an inkEdt control displays sheet row data, rows C2:C6 on Sheet MATT24. The code as is
copies every row separated by carriage return spaces for easier reading. The problem with this code the way it is now, is that it only colors the text string of the first row, cell C2 of the sheet. To work right, it should color the text string between quotes of every row displayed on the sheet = C2:C6. The image shows the result of what
this code does.

Private Sub cmdRUN3_Click()
Dim i As Long, r As Range
Dim intCount As Integer, n As Integer
Dim lngPos1 As Long, lngPos2 As Long
For i = 0 To Me.ListBox2.ListCount - 1
Row = Me.ListBox2.List(i)     ' current row to process
inkText.Text = inkText.Text + Row & vbCrLf & vbCrLf
GoSub color
Next i
Exit Sub
color:
Dim strIn As String
'inkText.Text = Sheets("MATT24").Range("C2")
strIn = Sheets("MATT24").Range("C2")
intCount = Len(strIn) - Len(Replace(strIn, """", ""))
lngPos1 = 1
With Me.inkText
    .SelLength = Len(inkText)
    .SelColor = vbBlue
    .SelLength = 0
End With
For n = 1 To intCount Step 2
    lngPos1 = InStr(lngPos1, strIn, """")
    lngPos2 = InStr(lngPos1 + 1, strIn, """") - 1
    With Me.inkText
        .SelStart = lngPos1
        .SelLength = lngPos2 - lngPos1
        .SelColor = vbRed
        .SelLength = 0
    End With
    lngPos1 = lngPos2 + 2
Next
Return
End Sub

Its only performing the string text coloring operation on the first row = C2. It should color all text strings between quotes from C2:C6.
It may be because of the carriage return spacing I put in the code. At any rate, I can't figure out where the problem is. It also colors
the rest in vbBlue.

Can anyone help to see where the problem in the code is?

Thanks very much for anyone's help.
cr

 

[Domenic]

Try the following macro...

Private Sub cmdRUN3_Click()

    Dim carriageReturnCount As Long
    Dim startPos As Long
    Dim endPos As Long
    Dim pos As Long
    
    inkText.Text = VBA.Join(Application.Transpose(Me.ListBox2.List), vbCrLf & vbCrLf)
    
    With inkText
        .SelStart = 0
        .SelLength = Len(.Text)
        .SelColor = vbBlue
    End With
    
    carriageReturnCount = 0
    startPos = -1
    endPos = -1
    pos = 1
    With Me.inkText
        Do While pos <= Len(.Text)
            If Mid$(.Text, pos, 2) = vbNewLine Then
                carriageReturnCount = carriageReturnCount + 1
                pos = pos + 2
            ElseIf Mid$(.Text, pos, 1) = Chr(34) Then
                If startPos >= 0 Then
                    endPos = pos - 1
                    .SelStart = startPos
                    .SelLength = (endPos - startPos + 1) - carriageReturnCount
                    .SelColor = vbRed
                    startPos = -1
                    endPos = -1
                Else
                    startPos = (pos - 1) - carriageReturnCount
                End If
                pos = pos + 1
            Else
                pos = pos + 1
            End If
        Loop
    End With

End Sub

Hope this helps!

 

[chazrab]

Try the following macro...

Private Sub cmdRUN3_Click()

    Dim carriageReturnCount As Long
    Dim startPos As Long
    Dim endPos As Long
    Dim pos As Long
   
    inkText.Text = VBA.Join(Application.Transpose(Me.ListBox2.List), vbCrLf & vbCrLf)
   
    With inkText
        .SelStart = 0
        .SelLength = Len(.Text)
        .SelColor = vbBlue
    End With
   
    carriageReturnCount = 0
    startPos = -1
    endPos = -1
    pos = 1
    With Me.inkText
        Do While pos <= Len(.Text)
            If Mid$(.Text, pos, 2) = vbNewLine Then
                carriageReturnCount = carriageReturnCount + 1
                pos = pos + 2
            ElseIf Mid$(.Text, pos, 1) = Chr(34) Then
                If startPos >= 0 Then
                    endPos = pos - 1
                    .SelStart = startPos
                    .SelLength = (endPos - startPos + 1) - carriageReturnCount
                    .SelColor = vbRed
                    startPos = -1
                    endPos = -1
                Else
                    startPos = (pos - 1) - carriageReturnCount
                End If
                pos = pos + 1
            Else
                pos = pos + 1
            End If
        Loop
    End With

End Sub

Hope this helps!

Hi Domenic thank you so much for replying. The first image below is the result of what is colored from your code. The first verse 24:2 is 100% correct. As you can see, the code colors "Matthew 24:4" in v4 and "Matthew 24:5" in v5. Those should be colored blue To work correctly, only the text between quotes(") should be colored red.

I made an image in Word and colored the text as it should be. The text of each verse in the sheet cells has been corrected with quotes in the correct places as shown in the Word image. This seems like it would be just a few small changes in your code to get this working correctly.

Correcting this code to work right is beyond my understanding. Would you be willing to help correct this ? Your code comes closest to the correct solution.
Thanks again, Domenic, for helping me with this. Look forward to hearing from you.
cr

 

[Domenic]

I almost missed it. The only reason I caught it is that I zoomed in on the image. After zooming in, I could see that some of your double quotes ( " ) are in fact left double quotation marks ( “ ) and right double quotation marks ( ” ). Try replacing the left and right double quotation marks with double quotes.

 

[chazrab]

I almost missed it. The only reason I caught it is that I zoomed in on the image. After zooming in, I could see that some of your double quotes ( " ) are in fact left double quotation marks ( “ ) and right double quotation marks ( ” ). Try replacing the left and right double quotation marks with double quotes.

It works. I assumed by what you mean by double quotes were " " . I tried that and it didn't work. After realizing that adjusting the quotes in the cell text reflects changes in how the text displays, I played around with this and what I found was that putting a space in between the beginning quote and the first letter that should begin in red, worked for me. I don't know if this is just luck or a quirk. I've shown this below enlarged. Moving the quote at the end of the red text with or without a space didn't seem to make any difference. I'm just happy that this thing works - hopefully bug free because I have to do this for about 3K lines - the 4 gospels and a few places elsewhere.

This has been a challenge for me for the past two yrs. Something I always wanted to add to make this app complete. The code seems simple enough

Thanks again, Domenic, for all your help. I have a lot of work ahead of me in getting these quotes placed correctly across 4 columns
and between 50-70 rows of text strings to color red

cr
Kingwood, Tx

 

[Domenic]

You should not have to place a space anywhere at all...

" - this is a double quote with ASCII value 34

“ - this is a left double quotation mark with the ASCII value 147

” - this is a right double quotation mark with the ASCII value 148

You can find those values in the ASCII table here...

ASCII table - Table of ASCII codes, characters and symbols

A complete list of all ASCII codes, characters, symbols and signs included in the 7-bit ASCII table and the extended ASCII table according to the Windows-1252 character set, which is a superset of ISO 8859-1 in terms of printable characters.

www.ascii-code.com

So simply use Find/Replace (Home tab >> Editing group >> Find & Select >> Replace)...

1) find “ and replace with "

2) find ” and replace with "

Does this help?

 

[chazrab]

You should not have to place a space anywhere at all...

" - this is a double quote with ASCII value 34

“ - this is a left double quotation mark with the ASCII value 147

” - this is a right double quotation mark with the ASCII value 148

You can find those values in the ASCII table here...

ASCII table - Table of ASCII codes, characters and symbols

A complete list of all ASCII codes, characters, symbols and signs included in the 7-bit ASCII table and the extended ASCII table according to the Windows-1252 character set, which is a superset of ISO 8859-1 in terms of printable characters.

www.ascii-code.com

So simply use Find/Replace (Home tab >> Editing group >> Find & Select >> Replace)...

1) find “ and replace with "

2) find ” and replace with "

Does this help?

Morning Domenic. You're exactly right. The quote location/spacing makes no difference. It was the quote characters in the original text in the underling sheet cells that was/is incorrect. The entire set of verses from Gen to Rev was copied from John Walkenbach's project he did years ago, and I've discovered that not all verses have quotes between Jesus' words. - some do and some don't.

I am now having to go down 3778 rows accross cols B,C, D and (for multiple translations - KJV = B, NIV = C, NASB = D and RSV = E, and insert quotes before and after the text I want in red so your code will display the colored text exactly correct in the userform textbox - blue before the quotes then red and blue after the last quote. I designed this app to use 4 translation/versions for comparison purposes.

This will probably take me the next 3 8 hour+ days to complete iserting the quotes correctly , but I'm committed to get this as accurate and right as it can be, and I know of no other way to do this either with a formula or code other than row by row, column by column verse by verse and physically inserting the quotes in the correct places - just some updates.

Because you've solved this major problem for this component of my app, I'd like to continue communicating with you if you are willing. I have to put navigation and search buttons on the form. I wrote all the code to do this successfully - but using a regular textbox and a Listbox Rowsource sheet as the data source, and I'm assuming an inkEdit control won't react weirdly when referring to it in code with the FIND and navigation codes when moving or searching or moving across and down from one verse to another and showing results displayed in the form correctly Sorry for being to wordy. Just an update and some preplanning on what lies ahead for this continuing project for our application.


Many thanks again, for all your help in this.
cr
Kingwood Tx

 

[Domenic]

You're very welcome, glad I could help.
,
With regards to any new questions, though, please, always start a new thread.

Cheers!