This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?

[chazrab]

Excel's VBA FIND method easily finds multiple records and copies them to another sheet. However, for me, trying to use this same code to do the
same thing with Acess's VBA code and a table is a different story. I know there is a difference between a sheet and an Access db table. And I know
won't recognize some oof the following code lines
I'm sure there has to be many cases where an Excel sheet gets so large that it facilitates porting the Excel application to Access's database based application

Such is my case. The main data Sheet has 31.103 rows and Excel stops responding at times. This is unacceptable for me. It has to work right every time.
Please take a look at this FIND method. Granted, it's long, but I' d really appreciate somone's help in moving this to Access.
I am not having any luck with trying to do the same thing with an Access Query. (The SQL copy Query to Table solution causes multiple conflicts and seems inefficient)

CORRECT EXCEL VBA FIND CODE
Private Sub cmdFIND_Click()
Sheets("MAINARES2").UsedRange.ClearContents
Dim lastrow, lastrow2 As Integer, X As String, c As Range, rw As Long, firstAddress As Variant, rowno As Variant, RownoA As Variant
X = MAINWINDOW2.TextBox11.Value
With Worksheets("Sheet2").Range("E1:E31103")
Set c = .FIND(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
rw = 1
firstAddress = c.Address
Do
Worksheets("Sheet2").Select
c.Select
Range(Cells(c.Row, 2), Cells(c.Row, 7)).Copy Destination:=Sheets("MAINARES2").Range("B" & rw)
rw = rw + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
lastrow = Sheets("MAINARES2").Range("B" & rows.count).End(xlUp).Row
If lastrow = 1 Then
Range(Cells(c.Row + 7, 2), Cells(c.Row, 7)).Copy Destination:=Sheets("MAINARES2").Range("B" & rw)
Else
End If
Else
MsgBox "value not found"
End If
End With
rowno = Sheets("MAINARES2").Range("B2").End(xlDown).Row
Sheets("MAINARES2").Range("H1").Value = rowno 'total rows found in search
Sheets("MAINARES2").Range("I1").Value = X 'value to find, i.e.,, "last days"
End Sub

I apoligize for a lengthy post - I don't like them - but I cannot explain my dilemma and have people understand with less words and code.
If anyone with both Excel and Access  build experience could help me, I'd really appreciate it vey much.

cr

 

[chazrab]

Hi Robert, things are working slow but well in refining this app on my end. Images below
I'm trying do this on my own to keep from relying on you so much. Truthfully, there's a learning curve.

I'm trying now to display the total records in a search in a textbox on the form, but can't do it the same way I did in Excel. Access gives error msg at this last line of the button code:

 Me.Totrecs.Value = DCount("*", "tblSearchResults")  --->"You can't assign a value to this object"

The traditional way in Excel is

    lastrow = Sheets("RESULTS").Range("B" & Rows.count).End(xlUp).Row
]/code]
More critically, I noticed the table the code is searching is tblTheBible.  That table is missing a significant number of verses for whatever reason.  I'm not sure if I created it or not.  I have another Access table of verses that i imported from Excel that is complete.  Its name is Sheet2.  All I see that needs to be done is change the table to  Sheet2 everywhere in the code.  Should be easy enough.

Well, that's it for  now.  As always thanks for you help and guidance.
cr

 

[Trebor76]

Hi Charles,

The syntax for the DCOUNT function is correct. What does the Control Source property (from within the form's Design mode) show? If it's bound to a table or query you can't change via code or else the link will be broken. Also ensure the control is actually a text from the Properties panel of the object again within the form's Design mode.

HTH

Robert

 

[chazrab]

Hi Robert. I got it to work. You were right. The Control Source in the textbox's Property window had that DCount function in it.
I just created another unbound textbox named totrows, assigned the function to a variable and now any new record count appears in totrows as soon as the button is clicked and the code runs - exactly what I wanted.

Dim cnt as long
cnt = DCount("*", "tblSearchResults")
Me.totrows.Value = cnt

Thanks again for all your help.
cr

 

[Trebor76]

Hi Charles,

Glad we got it working.

As an example here's how I would do find all matching word(s) in Excel using a recordset (you can pass SQL commands in VBA) which only takes one to two seconds to run for me:

Option Explicit
Sub FindUsingSQL()

    Dim wsSrc As Worksheet, wsOutput As Worksheet
    Dim objConn As Object, objRS As Object
    Dim strSearchText As String, strSQLStmt As String, strConnString As String
    Dim strText() As String, strWord As String, strTemp As String
    Dim intPosFrom As Integer, intPosTo As Integer
    Dim i As Long, j As Long, k As Long, x As Long
    Dim rngSearchResults As Range
    Dim xlnCalcMethod As XlCalculation
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
    End With
   
    Set wsSrc = ThisWorkbook.Sheets("Sheet2"): Set wsOutput = ThisWorkbook.Sheets("MAINARES2")
    On Error Resume Next
        wsSrc.ShowAllData: wsOutput.ShowAllData
    On Error GoTo 0
    wsOutput.UsedRange.ClearContents

    strSearchText = "believe"
  
    strSQLStmt = "SELECT * FROM [" & wsSrc.Name & "$D1:J31103] WHERE [F2] Like '%" & strSearchText & "%';"
    strConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=NO"";"
   
    Set objConn = CreateObject("ADODB.Connection"): Set objRS = CreateObject("ADODB.Recordset")
    objConn.Open strConnString
   
    With objRS
        .CursorType = 3 'adOpenStatic For a list of these literal values refer http://www.w3schools.com/asp/prop_rs_cursortype.asp
        .Open strSQLStmt, objConn
        If .RecordCount = 0 Then
            MsgBox """" & strSearchText & """ was not found."
        Else
            objRS.MoveFirst
            Do Until objRS.EOF
                strTemp = AlphaOnly(objRS.Fields(1))
                If InStr(strSearchText, " ") = 0 Then
                    strText = Split(strTemp, " ")
                    For i = LBound(strText) To UBound(strText)
                        'If there are tags then grab the word within them
                        intPosFrom = InStr(strText(i), ">"): intPosTo = InStr(strText(i), "<")
                        If intPosFrom > 0 And intPosTo > 0 Then
                            strWord = Split((Split(strText(i), ">")(1)), "<")(0)
                        Else
                            strWord = strText(i)
                        End If
                        If StrConv(strWord, vbLowerCase) = StrConv(strSearchText, vbLowerCase) Then
                            j = j + 1: x = x + 1
                        End If
                    Next i
                    If x > 0 Then
                        k = IIf(k = 0, 1, k + 1)
                        If rngSearchResults Is Nothing Then
                            Set rngSearchResults = wsSrc.Range("E" & objRS.Fields(0) & ":J" & objRS.Fields(0))
                        Else
                            Set rngSearchResults = Union(rngSearchResults, wsSrc.Range("E" & objRS.Fields(0) & ":J" & objRS.Fields(0)))
                        End If
                        x = 0
                    End If
                Else
                    'For more than one word just use INSTR
                    If InStr(StrConv(objRS.Fields(1), vbLowerCase), StrConv(strSearchText, vbLowerCase)) > 0 Then
                        j = j + 1
                        k = IIf(k = 0, 1, k + 1)
                        If rngSearchResults Is Nothing Then
                            Set rngSearchResults = wsSrc.Range("E" & objRS.Fields(0) & ":J" & objRS.Fields(0))
                        Else
                            Set rngSearchResults = Union(rngSearchResults, wsSrc.Range("E" & objRS.Fields(0) & ":J" & objRS.Fields(0)))
                        End If
                    End If
                End If
                objRS.MoveNext
            Loop
            If Not rngSearchResults Is Nothing Then
                rngSearchResults.Copy Destination:=wsOutput.Range("B1")
            Else
                MsgBox """" & strSearchText & """ was not found."
            End If
        End If
    End With
   
    Set objConn = Nothing: Set objRS = Nothing
   
    With Application
        .Calculation = xlnCalcMethod
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   
    If Not rngSearchResults Is Nothing Then
        If j = 0 Then
            MsgBox "There were no verses found that contained the text """ & strSearchText & """.", vbExclamation
        ElseIf j = 1 Then
            MsgBox "There was one verse found that contained the text """ & strSearchText & """.", vbExclamation
        Else
            k = wsOutput.Cells(Rows.Count, "B").End(xlUp).Row
            If k <> j Then
                MsgBox "The text """ & strSearchText & """ was found " & Format(j, "#,##0") & " times within " & Format(k, "#,##0") & " verses.", vbInformation
            Else
                MsgBox "The text """ & strSearchText & """ was found " & Format(j, "#,##0") & " times.", vbInformation
            End If
        End If
    End If

End Sub
Function AlphaOnly(strSource As String) As String
  
    Dim objRegExpr As Object
  
    Set objRegExpr = CreateObject("vbscript.regexp")

    With objRegExpr
        .Pattern = "[^a-zA-Z\s<>]+" 'Remove anything that is not a-z, A-Z, a space or HTML tags
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
    End With

    AlphaOnly = objRegExpr.Replace(strSource, "")
   
End Function

Note Col. D of Sheet2 is included the dataset as I used it for the count of verses which as there's no header is also row number so objRS(0). A similar concept could be used in Access.

Hope that helps,

Robert

 

[chazrab]

Wow, Robert. That's a lot of code. I need time to study this so I can understand the logic. The development of the Access version
of the Bible application is going faster for me now, as I gain experience understanding how the Access commands code logic, syntax and SQL work.

At this point I have to say I'm beginning to think this Bible app is much better suited to be developed in Access than Excel, but I will work on refining both versions.

One thing I've noticed - the application runs so much faster and the whole application seems to run a lot smoother in Access than Excel. I have no idea why. It just does.

I've made more development progress in the last 8 hours with this development in Access than since beginning porting this 3 weeks ago. There's two images at the bottom. One is a form named BOOKTABLE. This was a concept I took from the developer of Wordsearch. That form has a button for every one of the 66 books from Gen to Rev.

One click on any book button opens another form named BOOKCHAPTER, which also has numbered buttons from 1 to 80. (there are very few books in the Bible with that many chapters). Clicking on any one number button opens another form named - yep - CHAPTERVERSE. It also has 80 buttons, numbered from 1 to 80. (The only Bible book with more than 80 verses is Psalms, which has something like 153 or so. When that verse number is clicked, the txtSearchCriteria textbox is totally completed - book, chapter and verse - Genesis 12:3 - without touching the keyboard.

I haven't finished coding all these buttons yet. I took me all day with the one I created in Excel. I was able to do this a whole lot quicker in Access for whatever reason. Please take a look at the images below and the code behind the Gen button when you get a chance.

The last challenge on this component is to be able to make this same set of three book, chapter and verses forms available to Textbox2 or any other textbox - the only thing that would change is the other search criteria textbox(named versetxt).

Otherwise, I'd have to recreate 3 whole new table sets for Textbox2 and any other textbox.

To me, this is a much much better solution than manually typing in a book, chapter and verse, where typos could be made, or using cascading comboboxes, even if they do have autocomplete capabilities because it still involves typing.

I did all this in the Excel app and it works smooth, quick and simple. Besides, I think it looks cool.

Let me know what you think. I will spend some time to understand your code above
cr

 

[Trebor76]

Hi Charles,

I would use two list boxes - one to list the Bible's books and the other to list the verses from the book that gets selected (clicked on).
Have a look at the following where a single column listbox called "lbxBookList" is populated when the form is opened with the unique records from a field called "txtBookName" from a table called "tblBibleBooks". The three column listbox "lbxVerses" are then automatically populated once a selection in the "lbxBookList" is made (Note we can hide the Verse ID field so we can still reference it but the user won't see it as it not crucial they see it but you can reference everything you need with it):

Option Explicit
Option Compare Database
Private Sub Form_Open(Cancel As Integer)

    Dim db As Database
    Dim strSQL As String
        
    Set db = CurrentDb
    strSQL = "SELECT DISTINCT [txtBookName] FROM tblBibleBooks;"
    
    With Me.Controls("lbxBookList") 'Note - The 'Row Source Type' property for the 'lbxBookList' listbox control must be set to 'Table/Query' to populate a textbox this way
        .RowSource = strSQL
        .Requery
    End With
    
    Set db = Nothing

End Sub
Private Sub lbxBookList_Click()

    Dim db As Database
    Dim strSQL As String
    Dim lngVerseIDFrom As Long, lngVerseIDTo As Long

    lngVerseIDFrom = DMin("[lngID]", "tblBibleBooks", "[txtBookName] = '" & Me.lbxBookList.Value & "'")
    lngVerseIDTo = DMax("[lngID]", "tblBibleBooks", "[txtBookName] = '" & Me.lbxBookList.Value & "'")
    strSQL = "SELECT lngID, [txtVerseHeader], [txtVerseText_KJV] FROM tblBibleBooks WHERE lngID >= " & lngVerseIDFrom & " AND lngID <= " & lngVerseIDTo & ";"
    
    With Me.Controls("lbxVerses") 'Note - The 'Row Source Type' property for the 'lbxVerses' listbox control must be set to 'Table/Query' to populate a textbox this way
        .RowSource = strSQL
        .Requery
    End With
    
    Set db = Nothing

End Sub

It's also a good idea to use Option Explicit for each module in your application. See here for a good discussion on why.

Regards,

Robert

 

[chazrab]

Sat 5:13 AM:
Hi Robert - I only read through these code lines once, but I think I want to try this. I don't completely understand every line here, (and wish I did,
and hopefully eventually will), but the way you've described this sounds intriguing, because it seems like it can be applied to ANY textbox on the
form and repetitive code would not ha ve to be rewritten for each passage criteria textbox to just change one line for each criteria textbox that would
popuate larger textboxes.

THe way I see, this is that I'll start out by putting two listboxes on a new form and follow what you're doing here and see if I can get this to work - meaning populating the search criteria textbox for any form and clicking the Go button which fires the code for now.

The way I did this in Excel is that there's no separate Go button that needs a click to perform populating the large textboxes on the form - all that code is at the end of the verse number, so that the instant a user clicks the last verse number button, the text criteria textbox is immediately populated, the search is performed and the large textbox is populated with the found verses instantaneously - again, eliminating one more step of not having to click a button to populate the large textbox - it is immediately filled with all the verses the code finds. To me, that's so cool to do it this way

I'm at the starting point at this now, but I really like this idea.

cr

 

[Trebor76]

Hi Charles,

If you add the following your form it will automatically populate the two mentioned textboxes whenever a verse in the "lbxVerses" list box is clicked:

Private Sub lbxVerses_Click()

    Me.txtKJVText.Value = DLookup("txtVerseText_KJV", "tblBibleBooks", "lngID = " & Me.lbxVerses.Column(0))
    Me.txtASVText.Value = DLookup("txtVerseText_ASV", "tblBibleBooks", "lngID = " & Me.lbxVerses.Column(0))

End Sub

I've added a screen shot as to what it looks like (and like I said we can hide the Verse ID field).

Regards,

Robert

 

[chazrab]

I'm slowing catching up with your solutions. The search and display code only gives one verse if you type in
to txtSearchCriteria = "Matthew 24:15"

Result( with current code
15 " Therefore when you see the ABOMINATION OF DESOLATION which was spoken of through Daniel the prophet, standing in the holy place " (let the reader understand), Matthew 24:15 (NASB)

Desired:

15 " Therefore when you see the ABOMINATION OF DESOLATION which was spoken of through Daniel the prophet, standing in the holy place " (let the reader understand), Matthew 24:15 (NASB)
16 " then those who are in Judea must flee to the mountains. " Matthew 24:16 (NASB)
17 " Whoever is on the housetop must not go down to get the things out that are in his house. " Matthew 24:17 (NASB)
18 " Whoever is in the field must not turn back to get his cloak. " Matthew 24:18 (NASB)
19 " But woe to those who are pregnant and to those who are nursing babies in those days! " Matthew 24:19 (NASB)
20 " But pray that your flight will not be in the winter, or on a Sabbath." Matthew 24:20 (NASB)
21" For then there will be a great tribulation, such as has not occurred since the beginning of the world until now, nor ever will. " Matthew 24:21 (NASB) Note Note
22 " Unless those days had been cut short, no life would have been saved; but for the sake of the elect those days will be cut short. " Matthew 24:22 (NASB)
23 " Then if anyone says to you, ‘Behold, here is the Christ,’ or ‘There He is,’ do not believe him. " Matthew 24:23 (NASB)

I tried doing this myself. No idea where to begin, whether its changing the SQL in the query or this code in the Go button

Private Sub cmdTestCode_Click()
    Dim rs As Recordset
    Dim db As Database
    Dim strSQL As String
    Dim srchval As String
    srchval = Me.txtSearchCriteria.Value
    With DoCmd
        .SetWarnings False
        .OpenQuery "qmakSearch" 'qmakSearch is a make table query that must exist on the Db
        .SetWarnings True
    End With
    If DCount("*", "tblSearchResults") > 0 Then 'tblSearchResults is the MakeTable created table from qmkSearch query
       Me.Controls("txtMatchedVerses").Value = "" 'Clear - Note txtMatchedVerses is the name of the text box thta must exist on the form to receive the results of the SQL query.
        strSQL = "SELECT * FROM tblSearchResults;"
        Set db = CurrentDb: Set rs = db.OpenRecordset(strSQL)
        rs.MoveFirst
        Do Until rs.EOF
            Me.Controls("txtMatchedVerses").Value = IIf(Len(Me.Controls("txtMatchedVerses").Value) = 0, rs.Fields(0).Value, Me.Controls("txtMatchedVerses").Value & vbNewLine & rs.Fields(0).Value)
            rs.MoveNext
        Loop
           Set rs = Nothing: Set db = Nothing
       MsgBox "There were " & DCount("*", "tblSearchResults") & " records found.", vbInformation
     Else
        MsgBox "There were no records found.", vbExclamation
    End If
    Me.Totrows = DCount("*", "tblSearchResults")
End Sub

Did not completely understand the two Listbox solution. Searches will only look for two things; 1) a verse (as above) or 2) any word or phrase within
Bible all Bible verse text. First find the book --->then find the chapter--->then find the verse--->. Wouldn't that be 3 Listboxes? = 3 linked tables ?
Maybe I don't understand it completely. I already created the first Listbox of Bible Books = 66 items

3 linked tables to establish a 1-M -1-M - 1- M relationship? Or is this not necessary.
If I sound confused, I probably am.

Thx again for your help

 

[chazrab]

Hi again Robert - I tried this code from chatGPT but nothing happens when I click the button. No error msgs. Matthew 24:15 is not copied to
Tablei(the table I created) nor are the next 10 verses.

Sub CopyMatthewVerses()
    Dim rs As Recordset
    Dim strSQL As String
    Dim i As Integer
    Dim verseText As String
    Const tableName As String = "Table1"     ' Define your table name
    strSQL = "SELECT * FROM Sheet2 WHERE Verse = 'Matthew 24:15'"    ' Define the starting verse (Matthew 24:15)
    Set rs = CurrentDb.OpenRecordset(strSQL)
    If Not rs.EOF Then     ' Check if the record exists
        verseText = rs("VerseText")    ' Get the verse text
         For i = 1 To 10         ' Loop through the next 10 verses
            rs.MoveNext
            If Not rs.EOF Then
                verseText = verseText & vbCrLf & rs("VerseText")
            Else
                Exit For
            End If
        Next i
        CurrentDb.Execute "INSERT INTO " & Table1 & " (VerseText) VALUES ('" & Replace(verseText, "'", "''") & "')"         ' Insert the concatenated verses into your new table
    Else
        MsgBox "Matthew 24:15 not found in the source table."
    End If
    rs.Close
    Set rs = Nothing
End Sub