Simplify Code and return results to UF - ADO Access/Excel

[stapuff]

I have the following working, but would like to make a few changes.

Combine the three codes if possible & have the result of the MySQLcheck return to UF_WorkOrder.MultiPage1(2).eTB1.Value, UF_WorkOrder.MultiPage1(2).eTB2.Value, & UF_WorkOrder.MultiPage1(2).eTB3.Value respectively.

Thanks,

Kurt



Private Sub eCB3_Change()
Call GetRecords
End Sub




Public Sub GetRecords()
Dim rngTarget As Range
MySQLcheck = "SELECT [Qty],[Exp_Date],[Lot_Code] from XXXExp_Date1 where [W/O_#] = '" & UF_WorkOrder.MultiPage1(2).eCB3.Value & "' ;"
Set rngTarget = ActiveSheet.Range("A2")
Call RetrieveRecordset(MySQLcheck, rngTarget)
End Sub




Option Explicit
Private Const glob_DBPath = "S:\Open Project\SunnyD.mdb"
Private Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
Public Sub RetrieveRecordset(MySQLcheck As String, clTrgt As Range)
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim lFields As Long
Dim lRecrds As Long
Dim lCol As Long
Dim lRow As Long
cnt.Open glob_sConnect
rst.Open MySQLcheck, cnt

lFields = rst.Fields.Count
If Val(Mid(Application.Version, 1, InStr(1, Application.Version, ".") - 1)) > 8 Then
On Error Resume Next
clTrgt.CopyFromRecordset rst

If Err.Number <> 0 Then GoTo EarlyExit

Else
rcArray = rst.GetRows
lRecrds = UBound(rcArray, 2) + 1
For lCol = 0 To lFields - 1
For lRow = 0 To lRecrds - 1

If IsDate(rcArray(lCol, lRow)) Then
rcArray(lCol, lRow) = Format(rcArray(lCol, lRow))

ElseIf IsArray(rcArray(lCol, lRow)) Then
rcArray(lCol, lRow) = "Array Field"
End If
Next lRow
Next lCol

clTrgt.Resize(lRecrds, lFields).Value = TransposeDim(rcArray)
End If
EarlyExit:

rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub
Private Function TransposeDim(V As Variant) As Variant
Dim x As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
Xupper = UBound(V, 2)
Yupper = UBound(V, 1)
ReDim tempArray(Xupper, Yupper)
For x = 0 To Xupper
For Y = 0 To Yupper
tempArray(x, Y) = V(Y, x)
Next Y
Next x
TransposeDim = tempArray
End Function