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 ?

C

chazrab

Well-known Member
Joined
Oct 21, 2006
Messages
917
Office Version
  1. 365
Platform
  1. Windows
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)
Code: 
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
 
Sort by date Sort by votes
Change any fields I have named "txtKJV" to simply "KJV" i.e. the field name in your table "tblTheBible".

When there is an error like that copy the contents of the strSQL variable into the SQL section of a blank query and run it to give more of an insight as to why it's failing.

Robert
 
Last edited:
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
I've also just added Exit Sub near the top of the procedure to stop it if the initial value is not found as there's no need to continue and you may get the same message twice when the lngVerseID variable does not get set:

VBA Code: 
strSQL = "SELECT * FROM [tblTheBible] WHERE INSTR([KJV],""" & Controls("txtSearchText").Value & """)>0;"
    Set db = CurrentDb: Set rs = db.OpenRecordset(strSQL)
    If rs.EOF Then
        MsgBox """" & Me.Controls("txtSearchText").Value & """ was not found in the source table.", vbExclamation
        Exit Sub
 
Upvote 0
Hi Robert
I changed txtKJV to KJV everywhere and it does give the next 10 records below any verse I type in. But it displays them in a Msgbox, not in the txtMatchedVerses textbox on the form which is where the records are displayed. This code you wrote a while back does display records in the txtMatchedVerses textbox as we said it should, but only one verse is displayed for only one verse typed in txtSearchCriteria textbox.
Code: 
Private Sub cmdTestCode_Click()
    Dim x As String
    Dim rs As Recordset
    Dim db As Database
    Dim strSQL As String
    Dim srchval As String
    x = Me.txtSearchCriteria.Value
    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 & 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
Displaying the next 10 records when a verse is typed into txtSearchCriteria just needs to be adapted into this code. I tried doing that
myself and came up with errors, as you may have guessed. I tried to just put txtMatchVerses into where I thought it would go in your most recent
code, but in generated an error :
Code: 
Private Sub Mt2415_Click()
    Dim strSQL As String, strVerseText As String
    Dim dicSearchText As Object
    Dim varItem As Variant
    Dim rs As Recordset
    Dim db As Database
    Dim lngVerseID As Long, i As Long, j As Long, k As Long
    strSQL = "SELECT * FROM [tblTheBible] WHERE INSTR([KJV],""" & Controls("txtSearchText").Value & """)>0;"
    Set db = CurrentDb: Set rs = db.OpenRecordset(strSQL)
    If rs.EOF Then
        MsgBox """" & Me.Controls("txtSearchText").Value & """ was not found in the source table.", vbExclamation
    Else
        Set dicSearchText = CreateObject("Scripting.Dictionary")
        For Each varItem In Split(Controls("txtSearchText").Value, " ")
            i = i + 1
            dicSearchText.Add CStr(StrConv(varItem, vbLowerCase)), i
        Next varItem
        rs.MoveFirst
        Do Until rs.EOF
            For Each varItem In Split(rs.Fields("KJV"), " ")
                If IsNumeric(Left(varItem, 1)) = False Then
                varItem = AlphaOnly(CStr(varItem))
                End If
                If Not dicSearchText.Exists(CStr(StrConv(varItem, vbLowerCase))) = False Then
                    j = j + 1
                End If
            Next varItem
            If j = i Then
                lngVerseID = rs.Fields("ID")
                Exit Do
            End If
            j = 0
            rs.MoveNext
        Loop
        rs.Close
    End If
       If lngVerseID = 0 Then
        MsgBox """" & Me.Controls("[B]txtMatchedVerses[/B]").Value & """ was not found in the source table.", vbExclamation 'I put txtMatchedVerses between the [B] and [/B]
    Else
        strSQL = "SELECT * FROM [tblTheBible] WHERE ID >= " & lngVerseID & " AND ID <= " & lngVerseID + 10
        Set rs = db.OpenRecordset(strSQL)
        rs.MoveFirst
        Do Until rs.EOF
            k = k + 1
            strVerseText = IIf(Len(strVerseText) = 0, k & " " & rs.Fields("KJV"), strVerseText & vbNewLine & vbNewLine & k & " " & rs.Fields("KJV"))
            rs.MoveNext
        Loop
        MsgBox strVerseText
            rs.MoveNext '--->Error "No current record"
    End If
    Set rs = Nothing: Set db = Nothing
End Sub
 

Attachments

  • WORKSGREAY FOR DISPLAYING 10 VERSES BELOW IN A MSGBOX.png
    WORKSGREAY FOR DISPLAYING 10 VERSES BELOW IN A MSGBOX.png
    82.1 KB · Views: 7
Upvote 0
Hi Charles,

Here are both produces again with all the changes which works for me:

VBA Code: 
Option Compare Database
Option Explicit
Private Sub cmdSearch_Click()

    Dim strSQL As String, strVerseText As String
    Dim dicSearchText As Object
    Dim varItem As Variant
    Dim rs As Recordset
    Dim db As Database
    Dim lngVerseID As Long, i As Long, j As Long, k As Long
   
    strSQL = "SELECT * FROM [tblTheBible] WHERE INSTR([KJV],""" & Controls("txtSearchText").Value & """)>0;"
    Set db = CurrentDb: Set rs = db.OpenRecordset(strSQL)
    If rs.EOF Then
        MsgBox """" & Me.Controls("txtSearchText").Value & """ was not found in the source table.", vbExclamation
        Exit Sub
    Else
        Set dicSearchText = CreateObject("Scripting.Dictionary")
        For Each varItem In Split(Controls("txtSearchText").Value, " ")
            i = i + 1
            dicSearchText.Add CStr(StrConv(varItem, vbLowerCase)), i
        Next varItem
        rs.MoveFirst
        Do Until rs.EOF
            For Each varItem In Split(rs.Fields("KJV"), " ")
                If IsNumeric(Left(varItem, 1)) = False Then
                    varItem = AlphaOnly(CStr(varItem))
                End If
                If Not dicSearchText.Exists(CStr(StrConv(varItem, vbLowerCase))) = False Then
                    j = j + 1
                End If
            Next varItem
            If j = i Then
                lngVerseID = rs.Fields("ID")
                Exit Do
            End If
            j = 0
            rs.MoveNext
        Loop
        rs.Close
    End If
   
    If lngVerseID = 0 Then
        MsgBox """" & Me.Controls("txtSearchText").Value & """ was not found in the source table.", vbExclamation
    Else
        strSQL = "SELECT * FROM [tblTheBible] WHERE ID >= " & lngVerseID & " AND ID <= " & lngVerseID + 10
        Set rs = db.OpenRecordset(strSQL)
        rs.MoveFirst
        Do Until rs.EOF
            k = k + 1
            strVerseText = IIf(Len(strVerseText) = 0, k & " " & rs.Fields("KJV"), strVerseText & vbNewLine & k & " " & rs.Fields("KJV"))
            rs.MoveNext
        Loop
        txtMatchedVerses = strVerseText 'Populate 'txtMatchedVerses' textbox
    End If
   
    Set rs = Nothing: Set db = Nothing

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 or a space
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
    End With

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

Regards,

Robert
 
Upvote 0
Hi Robert. I'll have a look later. All of a sudden, I was changing code lines in the Load event, the 'Not responding...' came up, screen turned white. I had to go to Task Manager to close the app (little circle kept going round and round too long) I've looked everywhere - onedrive and the C drive on this machine and I cannot find the latest version which I named BIBLE APPLICATION.2.26.24 anywhere. Looking for the last hour.
I saved backups when prompted but I cannot find where they are stored. That file can't just disappear. It has to be somewhere. I would know if I accidentally deleted it because that involves a specific action which I did not do.

I'm trying not to let this get to me.
To be continued...hopefully.
cr
 
Upvote 0
...I found the file. Somewhere in this code is crashing the app. It worked early this AM. All this does is open the form with the textboxes populated
with records from tblSearchResults and mytbllSearchResults of the previous search:
Code: 
Private Sub Form_Load()
Me.txtSearchCriteria = gSavedValue
Dim cnt, cnt2 As Long
 If DCount("*", "tblSearchResults") > 0 Then
        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 & vbNewLine & rs.Fields(0).Value)
            rs.MoveNext
        Loop
        Set rs = Nothing: Set db = Nothing
    Else
    End If
cnt = DCount("*", "tblSearchResults")
Me.Totrows.Value = cnt
Me.totrows2.Value = cnt2


    Dim rs2 As Recordset
    Dim db2 As Database
    Dim strSQ2L As String
    With DoCmd
        .SetWarnings False
        .OpenQuery "txtbx2q"
        .SetWarnings True
    End With
    If DCount("*", "mytblSearchResults") > 0 Then
       Me.Controls("Textbox2").Value = ""
        strSQL = "SELECT * FROM maktxtbx2tbl;"
        Set db = CurrentDb: Set rs = db.OpenRecordset(strSQL)
        rs.MoveFirst
        Do Until rs.EOF
            Me.Controls("Textbox2").Value = IIf(Len(Me.Controls("Textbox2").Value) = 0, rs.Fields(1).Value, Me.Controls("Textbox2").Value & vbNewLine & vbNewLine & rs.Fields(1).Value)
            rs.MoveNext
        Loop
        Set rs = Nothing: Set db = Nothing
        MsgBox "There were " & DCount("*", "maktxtbx2tbl") & " records found.", vbInformation
    Else
        MsgBox "There were no records found.", vbExclamation
    End If
 Me.totrows2 = DCount("*", "maktxtbx2tbl")
End Sub
cr
 
Upvote 0
See if compiling the code raises any issues:
  1. Open the Visual Basic Editor (i.e. where you enter and edit the code)
  2. From the menu select Debug then Compile
There maybe variables that are not defined as I use Option Explicit (if there are - define them) or sometimes just compiling the code resolves the issue.
 
Upvote 0
Hi Robert - it works!. I know that's no big deal for you, but it's a giant leap for me in the progress of what I want this app to do
I just have to use that code as a template for Textbox2 and its associated versetxt2 field and any other textboxes I want to have
this capability with.

I have work to do on my end, so I'll be back with you later on my progress.

Thanks for taking the time for helping me with this app.

cr
 
Upvote 0
Hi Robert - it works!
Click to expand...

Great news (y) :cool:

If there are any more questions I really think you should post them in the Access section of the forum with a link back to this thread if you think it will help as you may get more support and it may help others if they are have similar Access issues. I'll keep an eye out as well.

Regards,

Robert
 
Upvote 0
Will do. I assume you mean this link from the address bar above:
www.mrexcel.com

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 ?

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...
www.mrexcel.com www.mrexcel.com

cr
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
How would i use the FIND method with the AND operator to find any two words in a sheet cell, i.e., "understanding" AND "heart"
2
Replies
11
Views
528
Trebor76
T
C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
197
chazrab
C
C
  • Question Question
Using >= in the Find method to find all values greater than $200 in column E. (i.e., ">=$200" - which is wrong)
Replies
8
Views
505
chazrab
C
C
  • Question Question
Using the Find method to copy 4 cell values above Find = X to another sheet for every value of X found in a column
Replies
6
Views
510
chazrab
C
G
  • Solved
Adapt VBA code where "Find" is equal to a MID function (etc)
Replies
6
Views
270
GTS
G

Forum statistics

Threads
1,223,932
Messages
6,175,468
Members
452,646
Latest member
tudou

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top