Access Qry as a Function

D

Darren Smith

Well-known Member
Joined
Nov 23, 2020
Messages
631
Office Version
  1. 2019
Platform
  1. Windows
This code I need to extract the access to access database code into a function please can someone help.

VBA Code: 
Sub Outline_Marker_Lights(sOutline_Marker_Lights As String)

Dim ws      As Worksheet
Dim Addme       As Range
Dim iRow        As Long
Dim qry         As String

Set ws = ThisWorkbook.Sheets("Job Card Master")

With ws
    iRow = Selection.Row
    Set Addme = ws.Range("A" & iRow)
    qry = "SELECT * FROM [Lights] " & _
    " WHERE [LightType]='" & sOutline_Marker_Lights & "'" & _
    " ORDER BY [ID] ASC"
    iRow = iRow
    Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            .Cells(iRow, 1) = rs.Fields("ItemNo").Value
            .Cells(iRow, 3) = rs.Fields("Description").Value
            .Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            .Cells(iRow, 5) = rs.Fields("Material/Part").Value
            .Cells(iRow, 7) = rs.Fields("Size").Value
            .Cells(iRow, 8) = rs.Fields("Qty").Value
            .Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
End With

End Sub
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
Hi Efan

There is no issue with the code but I need the code to open access and take detail see below to be as a function. So I can use it in mutable Subs
The idea is to cut down on the code size.

VBA Code: 
    Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            .Cells(iRow, 1) = rs.Fields("ItemNo").Value
            .Cells(iRow, 3) = rs.Fields("Description").Value
            .Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            .Cells(iRow, 5) = rs.Fields("Material/Part").Value
            .Cells(iRow, 7) = rs.Fields("Size").Value
            .Cells(iRow, 8) = rs.Fields("Qty").Value
            .Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
 
Upvote 0
May I ask why? That code is quite specific in terms of the values it returns and where it puts them.
 
Upvote 0
Because the idea was to use that code in many different subs. My Coding has grown very large.
 
Last edited:
Upvote 0
Your code takes data and dumps it in an excel sheet
From what I understand from your explaination, you want this as a function that will return a recordset you can use in many subs? In this case use the below:
VBA Code: 
Function getRecordset_Marker_Lights(sOutline_Marker_Lights As String) As ADODB.Recordset

Dim qry         As String

qry = "SELECT * FROM [Lights] " & _
" WHERE [LightType]='" & sOutline_Marker_Lights & "'" & _
" ORDER BY [ID] ASC"

Set getRecordset_Marker_Lights = OpenConAndGetRS(qry)
   
End Function
You'll need to add this reference if not already
ADODB reference.PNG



But if you will always just dump the data in a sheet but you want to specify what sheet then use this:
VBA Code: 
Sub Outline_Marker_Lights(sOutline_Marker_Lights As String, SheetName As String)

Dim ws      As Worksheet
Dim Addme       As Range
Dim iRow        As Long
Dim qry         As String

Set ws = ThisWorkbook.Sheets("SheetName")

With ws
    iRow = Selection.Row
    Set Addme = ws.Range("A" & iRow)
    qry = "SELECT * FROM [Lights] " & _
    " WHERE [LightType]='" & sOutline_Marker_Lights & "'" & _
    " ORDER BY [ID] ASC"
    iRow = iRow
    Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            .Cells(iRow, 1) = rs.Fields("ItemNo").Value
            .Cells(iRow, 3) = rs.Fields("Description").Value
            .Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            .Cells(iRow, 5) = rs.Fields("Material/Part").Value
            .Cells(iRow, 7) = rs.Fields("Size").Value
            .Cells(iRow, 8) = rs.Fields("Qty").Value
            .Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
End With

End Sub
We can do way more than this but its hard when we struggle to understand the question?
 
Upvote 0
Sorry, it`s this code below is that I need as a function. It gets used probably 40times at least in my coding.
Thanks for your reply.

VBA Code: 
  Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            .Cells(iRow, 1) = rs.Fields("ItemNo").Value
            .Cells(iRow, 3) = rs.Fields("Description").Value
            .Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            .Cells(iRow, 5) = rs.Fields("Material/Part").Value
            .Cells(iRow, 7) = rs.Fields("Size").Value
            .Cells(iRow, 8) = rs.Fields("Qty").Value
            .Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
End With

End Sub
 
Upvote 0
Something like:

VBA Code: 
Sub OutputAccessData(ws as worksheet, iRow as Long)
  Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            ws.Cells(iRow, 1) = rs.Fields("ItemNo").Value
            ws.Cells(iRow, 3) = rs.Fields("Description").Value
            ws.Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            ws.Cells(iRow, 5) = rs.Fields("Material/Part").Value
            ws.Cells(iRow, 7) = rs.Fields("Size").Value
            ws.Cells(iRow, 8) = rs.Fields("Qty").Value
            ws.Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
End With
End Sub
 
Upvote 0
Tried to call the code you created it says

Argument not optional
VBA Code: 
Sub Gantry_Steps_NS_OS(sGantry_Steps_NS_OS As String)

Dim qry         As String

qry = "SELECT * FROM [GantrySteps] " & _
    " WHERE [GantrySteps]='" & sGantry_Steps_NS_OS & "'" & _
    " ORDER BY [ID] ASC"

Call OutputAccessData
End Sub

Sub OutputAccessData(ws As Worksheet, iRow As Long)

  Set ws = ThisWorkbook.Worksheets("Job Card Master")
  iRow = Selection.Row

  Set Addme = ws.Range("A" & iRow)
  Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            ws.Cells(iRow, 1) = rs.Fields("ItemNo").Value
            ws.Cells(iRow, 3) = rs.Fields("Description").Value
            ws.Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            ws.Cells(iRow, 5) = rs.Fields("Material/Part").Value
            ws.Cells(iRow, 7) = rs.Fields("Size").Value
            ws.Cells(iRow, 8) = rs.Fields("Qty").Value
            ws.Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
End With
End Sub[CODE=vba]
 
Upvote 0
To use it like that, it should be:

VBA Code: 
Sub Gantry_Steps_NS_OS(sGantry_Steps_NS_OS As String)

Dim qry         As String

qry = "SELECT * FROM [GantrySteps] " & _
    " WHERE [GantrySteps]='" & sGantry_Steps_NS_OS & "'" & _
    " ORDER BY [ID] ASC"

Call OutputAccessData(qry)
End Sub

Sub OutputAccessData(qry as string)

  Set ws = ThisWorkbook.Worksheets("Job Card Master")
  iRow = Selection.Row

  Set Addme = ws.Range("A" & iRow)
  Dim rs As Object: Set rs = OpenConAndGetRS(qry)
    If Not (rs.BOF Or rs.EOF) Then
        Do While Not rs.EOF
            ws.Cells(iRow, 1) = rs.Fields("ItemNo").Value
            ws.Cells(iRow, 3) = rs.Fields("Description").Value
            ws.Cells(iRow, 4) = rs.Fields("TGSPartNo").Value
            ws.Cells(iRow, 5) = rs.Fields("Material/Part").Value
            ws.Cells(iRow, 7) = rs.Fields("Size").Value
            ws.Cells(iRow, 8) = rs.Fields("Qty").Value
            ws.Cells(iRow, 11) = rs.Fields("AllocHours").Value
            iRow = iRow + 1
            rs.MoveNext
        Loop
    End If
    rs.Close: Set rs = Nothing
End With
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

S
  • Question Question
User Form not Loading
Replies
5
Views
161
StevieMP
S
B
  • Solved
Use Sheet1:D5 to find matching cell in Sheet2 Column A:A, and select cell (or row)
Replies
1
Views
407
brianv
B
M
  • Question Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
405
mikefisher
M
I
  • Question Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
404
irishjsk
I
K
  • Question Question
Run-time error '-2147217900 (80040e14)': Syntax error or access violation
Replies
0
Views
94
kristianb63
K

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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