LBound(aLine) To UBound(aLine) Missing a line

D

Dreamweaver

Well-known member
Local time
Today, 16:27
Joined
Nov 28, 2005
Messages
2,467
This relates the https://www.access-programmers.co.uk/forums/threads/code-colors-like-in-vb-editor.310948/

It works perfectly When "_" is not found but just can't get it working if there is a "_"

It's must be something I'm doing but blind to it now.

Code: 
Private Sub Cmd_CodeComment_Click()
'=================================================================
'Description: Code Altered From Strive4Peaces Colour Compiler
'Called By: Command Button
'Calling: None
'Parameters: None
'Returns:
'Author: Michael Javes
'Editor(s):
'Date Created: 24th April 2020
'Rev. History:
'Requirements:
'=================================================================
   Dim aLine() As String _
   , sDeli As String _
   , dStrField As String _
   , I As Integer _
   , dResult As String _
   , dComs As String _
   , sLine As String _
   , dMLine As Boolean _
   , dUnder As Integer
  
On Error GoTo HandleErr
    'Setup Items Required
    dComs = DDLookUp("DfltComments", "tblPreferences")
    'set delimiter for lines
    sDeli = vbCrLf
    dStrField = Me![Txt_CodeDetails]
    dMLine = False
    'split code at line breaks
   aLine = Split(dStrField, sDeli)
    'process each line -- append Comments after First Line
   For I = LBound(aLine) To UBound(aLine)
        sLine = aLine(I)
        'Check Start Of Line For Required Text
        If Left(sLine, 16) = "<div>Private Sub" Or Left(sLine, 15) = "<div>Public Sub" _
         Or Left(sLine, 21) = "<div>Private Function" Or Left(sLine, 20) = "<div>Public Function" _
         Or Left(sLine, 8) = "<div>Sub" Or Left(sLine, 13) = "<div>Function" Then
            dUnder = InStr(sLine, "_")
            If dUnder > 0 Then 'Found Underscore
                'Just Add The Line
                dResult = dResult & sLine
            Else 'Not Found Underscore add the comments
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
            End If
        Else 'Not the start of a sub/function but is dUnder > 0
            If dUnder > 0 Then
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
                dUnder = 0 'Reset the Underscore count
            Else
                dResult = dResult & sLine
            End If
        End If
        
    Next I
        Me![Txt_CodeDetails] = dResult
    
HandleExit:
    Exit Sub
    
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume HandleExit
        Resume
    End Select
End Sub
 

Attachments

  • 2020-04-24.png
    2020-04-24.png
    73 KB · Views: 536
Well I can see that you set dUnder in only one part of the If statement, yet test it in the Else path?
 
The first line contines the underscore like
So I want the next line to add my comments in that case but not all functions/subs will be spilt between 2 or more lines like below

Rich (BB code): 
Public Function FillListsOne(StrItem As String, StrTable As String, _
'It puts my comments here which I dont want
                            StrField As String) As Integer
'But for this function I need to add the line for the function line then add my comments at the after  the As Integer above
On Error GoTo Err_HandleErr
    m_IntNew = MsgBox(StrItem & m_strMsg _
                , vbInformation + vbYesNo, "Item Not In List") 'Now new data has been detected as before adding just in case it's a mistake or needs editing
    If m_IntNew = vbYes Then 'If Yes Carry on with adding the new data
    Set m_rst = CodeDb.OpenRecordset(StrTable, dbOpenDynaset, dbAppendOnly) 'UPDATED 08/12/2018
    m_rst.AddNew 'Tell the system you want to add a new record
    m_rst(StrField) = ProperCase(StrItem) 'Add the item
    m_rst.Update 'Finish adding the record
    FillListsOne = acDataErrAdded ' Tell the combobox NotInList event that all is ok and no need to take any action
Else
    MsgBox StrItem & m_strUndoMsg, , m_strTitle 'If we got here it was a mistake so allow them to Undo it
        FillListsOne = acDataErrContinue 'Tell the NotInList event to undo the entry
    End If
  
Exit_HandleErr:
    m_rst.Close
    Set m_rst = Nothing
    Exit Function
  
Err_HandleErr:
    Select Case Err.Number
        Case 91
            Exit Function
        Case Else
            MsgBox "The Following Error Has Occured & vbCrLf" _
                   & "Error Number: " & Err.Number & vbCrLf & "Error Description" _
                   & vbCrLf & Err.Description
            Resume Exit_HandleErr
        Resume
    End Select

End Function
 
Yes, and if you follow the code with F8 you should see why?

The first line in your test has a _ (you should probably be testing for " _" (space and undescore) as well ?
So your first line when I is one find the _
The next line does not have any of theose key words and so you go to the else part YET dunder is still > 0 from the previous test, so you add the comments

Rich (BB code): 
     Else 'Not the start of a sub/function but is dUnder > 0
            If dUnder > 0 Then
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
                dUnder = 0 'Reset the Underscore count
            Else
                dResult = dResult & sLine
            End If
        End If
 
Hi Mick,

Your naming convention is difficult to understand.

What is the significance of 'd' in dStrField, dResult, dComs, dMLine and dUnder?
 
I've done a screen catpture which seems to be working as Intended but I must be missing something

 
Very pretty. :)

Look at what happens on your second pass through the code and please reread my posts again.

I really do not know how to explain it any better.? :(
 
Sorry Still can't see it I'll step away from it for a while and do something else as I might be blind to it at the moment.

thanks @Gasman
 
Wht not step back and debug.print the input line and result on each pass.?

I still think it is beacuse you are not resetting dUnder, but from your code, you should still get sLine added to dresult.

Of course you could always NOT use the continuation character. :D
 
Last edited:
I've run it with Debugs Back the results are belowthe code of me stepping through 3 lines

Code: 
Private Sub Cmd_CodeComment_Click()
'=================================================================
'Description: Code Altered From Strive4Peaces Colour Compiler
'Called By: Command Button
'Calling: None
'Parameters: None
'Returns:
'Author: Michael Javes
'Editor(s):
'Date Created: 24th April 2020
'Rev. History:
'Requirements:
'=================================================================
   Dim aLine() As String _
   , sDeli As String _
   , dStrField As String _
   , I As Integer _
   , dResult As String _
   , dComs As String _
   , sLine As String _
   , dUnder As Integer
  
On Error GoTo HandleErr
    'Setup Items Required
    dComs = DDLookUp("DfltComments", "tblPreferences")
    'set delimiter for lines
    sDeli = vbCrLf
    dStrField = Me![Txt_CodeDetails]
    'split code at line breaks
   aLine = Split(dStrField, sDeli)
    'process each line -- append Comments after First Line
   For I = LBound(aLine) To UBound(aLine)
        sLine = aLine(I)
        'Check Start Of Line For Required Text
        If Left(sLine, 16) = "<div>Private Sub" Or Left(sLine, 15) = "<div>Public Sub" _
         Or Left(sLine, 21) = "<div>Private Function" Or Left(sLine, 20) = "<div>Public Function" _
         Or Left(sLine, 8) = "<div>Sub" Or Left(sLine, 13) = "<div>Function" Then
            dUnder = InStr(sLine, " _")
            If dUnder > 0 Then 'Found Underscore
                Debug.Print "First Test First Line Underscrore FOUND"
                'Just Add The Line
                dResult = dResult & sLine
            Else 'Not Found Underscore add the comments
                Debug.Print "First Test First Line NO Underscrore"
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
            End If
        Else 'Not the start of a sub/function but is dUnder > 0
            If dUnder > 0 Then
                Debug.Print "Second Line Underscore FOUND previous Loop"
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
                dUnder = 0 'Reset the Underscore count
            Else
                Debug.Print "Second Line NO Underscore found previous Loop"
                dResult = dResult & sLine
            End If
        End If
       
    Next I
        Me![Txt_CodeDetails] = dResult
   
HandleExit:
    Exit Sub
   
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume HandleExit
        Resume
    End Select
End Sub

Below is whats printed on each loop
First Test First Line Underscrore FOUND
Second Line Underscore FOUND previous Loop
Second Line NO Underscore found previous Loop

I'm out for a while thanks for your help @Gasman
 
Well I think we know the paths on each loop, that was evident from your video even if one could not work it out from the code.?

I would be debug.print the sline and result any time they are mentioned, or inspect them at least.?

On your second pass it *looks* like you should get sline added to result then get your comments?, however if this was me, I would be checking each of these on every pass with F8, as I always find my silly errors that way. By silly I mean that you will kick yourself when you find it, but for now it looks impossible.?

My inital thoughts were, that you should be checking dUnder for each line?
 
Ok, it appears it was working all along, however I do not know how you got your output.?

When I tried your code I got for dresult on second pass

Code: 
<div>Public Function FillListsOne(StrItem As String, StrTable As String, _                            StrField As String) As Integer
test comment line

Up to you where you put it, but I tried it as
Code: 
<div>Public Function FillListsOne(StrItem As String, StrTable As String, _
                            StrField As String) As Integer
test comment line

using
Rich (BB code): 
        Else 'Not the start of a sub/function but is dUnder > 0
            If dUnder > 0 Then
                dResult = dResult & vbCrLf & sLine & vbCrLf & dComs & vbCrLf
So I now think you need a vbCRLF after each sLine as I eventually got

Code: 
? dresult
<div>Public Function FillListsOne(StrItem As String, StrTable As String, _
                            StrField As String) As Integer
test comment line
On Error GoTo Err_HandleErr    m_IntNew = MsgBox(StrItem & m_strMsg _

HTH
 
I've found whats happening But I don't knw why

Code: 
    If dUnder > 0 Then
                Debug.Print "Second Line Underscore FOUND previous Loop"
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
                dUnder = 0 'Reset the Underscore count
                Debug.Print sLine'<===
            Else
                Debug.Print "Second Line NO Underscore found previous Loop"
                dResult = dResult & sLine
                Debug.Print dResult
            End If
Where I coloured it red even though that section of code runs sLine is empty but it gets the value on the next loop but then dUnder <>0 So the Else runs but it seems to keep adding the comments
 
Think I found whats happening
This is the function I'm using to test if you look at it there are more than 1 _

Instead of using this dUnder = InStr(sLine, " _") This I now see will be a big problem down the code
so What I'm thinking of doing is testing the end of the call IE As Long Etc unless anybody can think of a better way?

Code: 
Public Function FillListsOne(StrItem As String, StrTable As String, _
                            StrField As String) As Integer
On Error GoTo Err_HandleErr
    m_IntNew = MsgBox(StrItem & m_strMsg _
                , vbInformation + vbYesNo, "Item Not In List") 'Now new data has been detected as before adding just in case it's a mistake or needs editing
    If m_IntNew = vbYes Then 'If Yes Carry on with adding the new data
    Set m_rst = CodeDb.OpenRecordset(StrTable, dbOpenDynaset, dbAppendOnly) 'UPDATED 08/12/2018
    m_rst.AddNew 'Tell the system you want to add a new record
    m_rst(StrField) = ProperCase(StrItem) 'Add the item
    m_rst.Update 'Finish adding the record
    FillListsOne = acDataErrAdded ' Tell the combobox NotInList event that all is ok and no need to take any action
Else
    MsgBox StrItem & m_strUndoMsg, , m_strTitle 'If we got here it was a mistake so allow them to Undo it
        FillListsOne = acDataErrContinue 'Tell the NotInList event to undo the entry
    End If
  
Exit_HandleErr:
    m_rst.Close
    Set m_rst = Nothing
    Exit Function
  
Err_HandleErr:
    Select Case Err.Number
        Case 91
            Exit Function
        Case Else
            MsgBox "The Following Error Has Occured & vbCrLf" _
                   & "Error Number: " & Err.Number & vbCrLf & "Error Description" _
                   & vbCrLf & Err.Description
            Resume Exit_HandleErr
        Resume
    End Select
End Function
 
This works but will have to do more testing
Code: 
Private Sub Cmd_CodeComment_Click()
'=================================================================
'Description: Code Altered From Strive4Peaces Colour Compiler
'Called By: Command Button
'Calling: None
'Parameters: None
'Returns:
'Author: Michael Javes
'Editor(s):
'Date Created: 24th April 2020
'Rev. History:
'Requirements:
'=================================================================
   Dim aLine() As String _
   , sDeli As String _
   , dStrField As String _
   , I As Integer _
   , dResult As String _
   , dComs As String _
   , sLine As String _
   , dUnder As Integer
  
On Error GoTo HandleErr
    'Setup Items Required
    dComs = DDLookUp("DfltComments", "tblPreferences")
    'set delimiter for lines
    sDeli = vbCrLf
    dStrField = Me![Txt_CodeDetails]
    'split code at line breaks
   aLine = Split(dStrField, sDeli)
    'process each line -- append Comments after First Line
   For I = LBound(aLine) To UBound(aLine)
        sLine = aLine(I)
        'Check Start Of Line For Required Text
        If Left(sLine, 16) = "<div>Private Sub" Or Left(sLine, 15) = "<div>Public Sub" _
         Or Left(sLine, 21) = "<div>Private Function" Or Left(sLine, 20) = "<div>Public Function" _
         Or Left(sLine, 8) = "<div>Sub" Or Left(sLine, 13) = "<div>Function" Then
            If InStr(sLine, ") As Integer") Then 'Found Underscore
                dResult = dResult & vbCrLf & sLine & vbCrLf & dComs & vbCrLf
            Else 'Not Found Underscore add the comments
                dResult = dResult & sLine
            End If
        Else 'Not the start of a sub/function but is dUnder > 0
            If InStr(sLine, ") As Integer") Then
                dResult = dResult & sLine & vbCrLf & dComs & vbCrLf
            Else
                dResult = dResult & sLine
            End If
        End If
        
    Next I
        Me![Txt_CodeDetails] = dResult
    
HandleExit:
    Exit Sub
    
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume HandleExit
        Resume
    End Select
End Sub
 
So what do you with this line?

Code: 
            MsgBox "The Following Error Has Occured & vbCrLf" _
                   & "Error Number: " & Err.Number & vbCrLf & "Error Description" _
                   & vbCrLf & Err.Description
 
Did you see my last post As I figured that was what was causing the problem so edited the code but even that wont work completly as Subs dont return a value to have to do a rethink again lol
 
MickJav said:
Did you see my last post As I figured that was what was causing the problem so edited the code but even that wont work completly as Subs dont return a value to have to do a rethink again lol
Click to expand...
Yes, that was why I was asking about how your current code would work with that part.?
 
Just wondering if I could use a click and past where the user wants the comments as Can't see a good way of doing it now.
 
That wont work I will find a way just going to have to jump through a lot og hops
 
You must log in or register to reply here.

Similar threads

T
Can someone please assist with the VBA code Below - Error Message 3075
Replies
16
Views
763
CJ_London
C
K
How can I add this code to the storage location of my file before scanning and then convert it to a PDF file?
2
Replies
25
Views
963
The_Doc_Man
The_Doc_Man
J
Error "Can't set focus"
2
Replies
21
Views
488
Isaac
Isaac
Jason Lee Hayes
Solved Open Outlook & check for new mail where search criteria is applied to the email subject line
Replies
19
Views
609
Jason Lee Hayes
Jason Lee Hayes
C
Select Case Textbox
Replies
7
Views
688
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom