hatman
Well-known Member
- Joined
- Apr 8, 2005
- Messages
- 2,664
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:
and
My data is being brought to a common workbook from multiple data export workbooks. Here is the relevant portions of the code:
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
Code:
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