Access Qry as a Function

[Darren Smith]

This code I need to extract the access to access database code into a function please can someone help.

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

 

[EFANYoutube]

Hi Darren,
Whats the error?
At a glance your code seems right!

 

[Darren Smith]

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.

    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

 

[RoryA]

May I ask why? That code is quite specific in terms of the values it returns and where it puts them.

 

[Darren Smith]

Because the idea was to use that code in many different subs. My Coding has grown very large.

 

[EFANYoutube]

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:

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

But if you will always just dump the data in a sheet but you want to specify what sheet then use this:

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?

 

[Darren Smith]

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.

  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

 

[RoryA]

Something like:

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

 

[Darren Smith]

Tried to call the code you created it says

Argument not optional

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]

 

[RoryA]

To use it like that, it should be:

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