ADO Query of Worksheet - Some Data Blank

[hatman]

I have (2) data sets on (2) worksheets that I want to JOIN. I thought I was being slick by using ADO to get the job done, but now I'm not so sure. When I did the initial JOIN, everything looked good, except that a couple of fields of Dates and Numbers were completely blank... not ALL fields of numbers and dates, only a few. After some research, I found an article that talked about the ADO routine finding a discrepancy between the stated data type of the cell versus the actual data, and returning a NULL. I found that if I format one of the problematic source cells as TEXT, then enter the cell, press F2 and hit Enter, then re-run the query, it works fine for that one value. But formatting an entire column doesn't work. I found another article that talked about using TextToColumns to make formatting changes take effect... but that also didn't work. I am stymied.

My data is being brought to a common workbook from multiple data export workbooks. Here is the relevant portions of the code:

Function Get_WB_Of_Raw_Data() As Excel.Workbook

    Dim arrReport_Type() As Variant
    Dim arrCell_Offset() As Variant
    Dim arrFile_Paths() As Variant
    Dim arrSheet_Names() As Variant
    Dim arrStart_Row() As Variant
    Dim arrStart_Col() As Variant
    Dim cnt As Integer
    Dim wbSource As Excel.Workbook
    Dim wbDest As Excel.Workbook
    Dim Num_Shts As Integer
    Dim sql As String
    Dim rsCols As ADODB.Recordset
    Dim Must_Close_DB As Boolean
    Dim shtSource As Excel.Worksheet
    Dim shtDest As Excel.Worksheet
    Dim rowcountSource As Long
    Dim rowcountDest As Long
    Dim colSource As String
    Dim colDest As String
    Dim cntColDest As Long
    Dim arr As Variant
    
    
    If xlApp Is Nothing Then Set xlApp = Application
    
    #If Not early_bound Then
    
        Const xlUp As Long = -4162
        
    #End If
    
    
    If fullpathME5A = "" Then
    
        fullpathME5A = "T:\TEMP\" & fnameME5A
        fullpathZMM_RCPTBAL = "T:\TEMP\" & fnameZMM_RCPTBAL
'        fullpathZSC_VAL_PO = "T:\TEMP\" & fnameZSC_VAL_PO
        fullpathZSC_PO_PRICE_INF = "T:\Temp\" & fnameZSC_PO_PRICE_INF
        
    End If
    
    Must_Close_DB = Open_DATA_Connection
    
    arrReport_Type = Array("PR_", "RFQ", "PO_")
    arrCell_Offset = Array(0, -1, 1)
    arrFile_Paths = Array(fullpathME5A, fullpathZSC_PO_PRICE_INF, fullpathZMM_RCPTBAL)
    arrSheet_Names = Array("PRs_per_ME5A", "RFQs_per_ZSC_PO_PRICE_INF", "POs_per_ZMM_RCPTBAL")
    arrStart_Row = Array(4, 7, 5)
    arrStart_Col = Array("B", "C", "C")
    
    Num_Shts = xlApp.SheetsInNewWorkbook
    
    xlApp.SheetsInNewWorkbook = 10
    
    Set wbDest = xlApp.Workbooks.Add
    
    xlApp.SheetsInNewWorkbook = Num_Shts
    
    For cnt = 0 To UBound(arrReport_Type)
    
        Set wbSource = xlApp.Workbooks.Open(arrFile_Paths(cnt))
        
        Set shtSource = wbSource.Worksheets(1)
        Set shtDest = wbDest.Worksheets(cnt + 1)
        
        shtDest.Name = CStr(arrSheet_Names(cnt))
        
        'this doesn;t make a difference
        shtDest.Cells.NumberFormat = "@"
        
        rowcountSource = shtSource.Range(arrStart_Col(cnt) & xlApp.Rows.Count).End(xlUp).Row
        rowcountDest = rowcountSource - (arrStart_Row(cnt))
        
        sql = "SELECT * FROM " & Table_Raw_Field_Map & " WHERE Report_Source = '" & arrReport_Type(cnt) & _
            "' AND Bus_Unit = '" & Bus_Unit & "' ORDER BY Default_Source_Col_Letter"
            
        Set rsCols = objD_Base.CreateRecordset(sql)
        
        cntColDest = 1
        
        Do Until rsCols.EOF
        
            colSource = Get_Source_Col_Letter(rsCols("Default_Source_Col_Letter").Value & _
                arrStart_Row(cnt), _
                arrCell_Offset, rsCols("Native_Field_Name").Value, shtSource)
                
            arr = Split(shtDest.Cells(1, cntColDest).Address, "$")
            
            colDest = arr(1)
            
            shtDest.Range(colDest & 1).Value = _
                arrReport_Type(cnt) & Get_Stripped_Field_Name(rsCols("Long_Field_Name").Value)
                
            shtDest.Range(colDest & 2 & ":" & colDest & rowcountDest).Value = _
                "A" & shtSource.Range(colSource & arrStart_Row(cnt) + 2 & ":" & colSource & rowcountSource).Value
                
            'well this didn;t help
            shtDest.Range(colDest & 2 & ":" & colDest & rowcountDest).TextToColumns Destination:=shtDest.Range(colDest & 2), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(1, 1), TrailingMinusNumbers:=True
        
            rsCols.MoveNext
            
            cntColDest = cntColDest + 1
            
        Loop
        
        Set shtDest = Nothing
        Set shtSource = Nothing
        
        wbSource.Close False
        
        rsCols.Close
        
    
    Next cnt
    
    Set rsCols = Nothing
    Set wbSource = Nothing
    
    If Must_Close_DB Then
    
        Call Close_DATA_Connection
        
    End If
    
    Set Get_WB_Of_Raw_Data = wbDest

End Function

and

Sub Join_PR_to_RFQ(wb As Excel.Workbook)

    Dim shtDest As Excel.Worksheet
    Dim shtPR As Excel.Worksheet
    Dim shtRFQ As Excel.Worksheet
    
    Dim objConnection As ADODB.Connection
    Dim objRecordset As ADODB.Recordset
    Dim cnt As Long
    Dim sql As String
    
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    
    Set objConnection = New ADODB.Connection
    Set objRecordset = New ADODB.Recordset
    
    Set shtDest = wb.Worksheets(4)
    Set shtPR = wb.Worksheets(1)
    Set shtRFQ = wb.Worksheets(2)
    
    shtDest.Name = "PR_JOIN_RFQ"
    
    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & wb.FullName & _
            ";Extended Properties=""Excel 8.0;HDR=Yes;"";"

'    sql = "SELECT * FROM [" & shtPR.Name & "$] a LEFT JOIN [" & shtRFQ.Name & "$] b " & _
        "ON a.PR_Purchase_Requisition = b.RFQPurchase_requisition_number AND " & _
        "a.PR_Item_of_Requisition = b.RFQItem_Number_of_Purchasing_Document"
        
    sql = "SELECT * FROM [" & shtPR.Name & "$]"
          
    objRecordset.Open sql, objConnection, adOpenStatic, adLockOptimistic, adCmdText
        
        
    For cnt = 1 To objRecordset.Fields.Count
    
        shtDest.Cells(1, cnt).Value = objRecordset.Fields(cnt - 1).Name
    
    Next cnt
        
    shtDest.Range("A2").CopyFromRecordset objRecordset
        
    objRecordset.Close
    Set objRecordset = Nothing
    
    objConnection.Close
    Set objConnection = Nothing
    
    Set shtDest = Nothing
    Set shtPR = Nothing
    Set shtRFQ = Nothing


End Sub