In MS Access I am using VBA to iterate multiple Excel sheets, I then perform a left join on 5 sheets based on the shared join key "Unique Transaction ID". After that is merged I save that to the end of the Excel file. So now I have a sheet that is a merge of those 5 sheets. The problem is I need to preserve/apply or at least be able to reference the data types of the previous sheets.
What I tried doing is after the left join is performed, then create a dictionary that references all the correct ranges of the sheets and applies the data types found there. But this doesn't work because it seems to just assume one data type and apply it to the column. There could be many different data types in a column, I need either a granular way to apply the data types to the merged sheet, or a way to reference the previous sheets with the correct orientation of how the merged sheet is setup.
Here is what I've tried. This is my left join code for the sheets and my attempt at using a dictionary to apply the data types:
Dim ls_last_row As Long
Dim cs_last_row As Long
Dim e_sheet_last_row As Long
Dim p_sheet_last_row As Long
Set ls = objFile.Worksheets("2. sheet")
Set cs = objFile.Worksheets("3. sheet")
Set es = objFile.Worksheets("4. sheet")
Set ps = objFile.Worksheets("5. sheet")
l_sheet_last_row = ls.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
cs_last_row = cs.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
e_sheet_last_row = es.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
p_sheet_last_row = ps.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
' loading in sheet2 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet2", filePath, True, "2. sheet!A1:AU" & loan_sheet_last_row
' loading in sheet3 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet3", filePath, True, "3. sheet!A1:I" & cs_last_row
' loading in sheet4 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet4", filePath, True, "4. sheet!A1:H" & e_sheet_last_row
' loading in shset5 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet5", filePath, True, "5. sheet!A1:D" & p_sheet_last_row
'Execute SQL statement to perform the join
Dim strSql As String
strSql = "SELECT sheet2.*, sheet3.*, sheet4.*, sheet5.* " _
& "FROM ((tmp_sheet2 AS sheet2 " _
& "LEFT JOIN tmp_sheet3 AS sheet3 ON CSTR(sheet2.[Unique Transaction ID]) = CSTR(sheet3.[Unique Transaction ID])) " _
& "LEFT JOIN tmp_sheet4 AS sheet4 ON CSTR(sheet2.[Unique Transaction ID]) = CSTR(sheet4.[Unique Transaction ID])) " _
& "LEFT JOIN tmp_sheet5 AS sheet5 ON CSTR(sheet2.[Unique Transaction ID]) = CSTR(sheet5.[Unique Transaction ID])"
'Create new table with join results
DoCmd.SetWarnings False
Dim tableName As String
tableName = "joined_table"
DoCmd.RunSQL "SELECT * INTO " & tableName & " FROM (" & strSql & ")"
DoCmd.RunSQL "ALTER TABLE joined_table DROP COLUMN [sheet3_Unique Transaction ID]"
DoCmd.RunSQL "ALTER TABLE joined_table DROP COLUMN [sheet4_Unique Transaction ID]"
DoCmd.RunSQL "ALTER TABLE joined_table DROP COLUMN [sheet5_Unique Transaction ID]"
'Add joined_table to ms-access
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM " & tableName)
Set newSheet = objFile.Worksheets.Add(After:=objFile.Worksheets(objFile.Worksheets.Count))
newSheet.Name = "2. Transaction Data"
' Copy header names to new sheet
Dim headerRange As Range
Dim i As Integer
Set headerRange = newSheet.Range("A1")
For i = 0 To rs.Fields.Count - 1
If i = 0 Then
headerRange.Offset(0, i) = "Unique Transaction ID"
Else
headerRange.Offset(0, i) = rs.Fields(i).Name
End If
Next i
' Copy data to new sheet
headerRange.Offset(1, 0).CopyFromRecordset rs
' create dictionary to store row numbers for IDs in Sheet 2
Dim idDict As Object
Set idDict = CreateObject("Scripting.Dictionary")
For i = 2 To loan_sheet_last_row
idDict.Add ls.Cells(i, 1).Value, i
Next i
' iterate sheet 2, store its data types and apply to newSheet
Dim j As Long
For i = 2 To loan_sheet_last_row
Dim id As Variant
id = ls.Cells(i, 1).Value ' assume ID is in column 1
Dim matchRow As Variant
If idDict.Exists(id) Then
Dim rowNumber As Long
rowNumber = idDict(id)
For j = 1 To 47 'iterate from column B to AU (2 to 47)
Dim dataType As String
dataType = TypeName(ls.Cells(i, j).Value)
newSheet.Cells(rowNumber, j).NumberFormat = GetNumberFormat(dataType)
Next j
End If
Next i
' iterate Sheet3, store its data types and apply to newSheet
Dim k As Long
For i = 2 To cs_last_row ' start from row 2 to skip header
id = cs.Cells(i, 1).Value ' assuming ID is in column 1
If idDict.Exists(id) Then
rowNumber = idDict(id)
For k = 2 To 9 ' iterate from colum B to column I
dataType = TypeName(cs.Cells(i, k).Value)
newSheet.Cells(rowNumber, k + 46).NumberFormat = GetNumberFormat(dataType)
Next k
End If
Next i
' iterate Sheet4, store its data types and apply to newSheet
Dim q As Long
For i = 2 To e_sheet_last_row ' start from row 2 to skip header
id = es.Cells(i, 1).Value ' assuming ID is in column 1
If idDict.Exists(id) Then
rowNumber = idDict(id)
For q = 2 To 8 ' iterate from column B to column H
dataType = TypeName(es.Cells(i, q).Value)
newSheet.Cells(rowNumber, q + 54).NumberFormat = GetNumberFormat(dataType)
Next q
End If
Next i
' iterate Sheet5, store its data types and apply to newSheet
Dim p As Long
For i = 2 To p_sheet_last_row ' start from row 2 to skip header
id = ps.Cells(i, 1).Value ' assuming ID is in column 1
If idDict.Exists(id) Then
rowNumber = idDict(id)
For p = 2 To 4 ' iterate from column B to column D
dataType = TypeName(ps.Cells(i, p).Value)
newSheet.Cells(rowNumber, p + 61).NumberFormat = GetNumberFormat(dataType)
Next p
End If
Next i
rs.Close
Set rs = Nothing
Here is the GetNumberFormat method:
Function GetNumberFormat(dataType As String) As String
'**********************************************************************
' Listed below is Excel's data types and VBA's NumberFormat equivalent
' General: General
' Number: 0
' Currency: $#,##0.00;[Red]$#,##0.00
' Accounting: _($* #,##0.00_);_($* (#,##0.00);_($* "-"??_);_(@_)
' Date: m/d/yyyy
' Time: [$-F400]h:mm:ss am/pm
' Percentage: 0.00%
' Fraction: # ?/?
' Scientific: 0#
' String: @
' Special: ;;
' Custom: #,##0_);[Red](#,##0)
'**********************************************************************
Select Case dataType
Case "String"
GetNumberFormat = "@"
Case "Date"
GetNumberFormat = "m/d/yyyy"
Case "Currency"
GetNumberFormat = "$#,##0.00;[Red]$#,##0.00"
Case "Double"
GetNumberFormat = "0"
Case "Integer"
GetNumberFormat = "0"
Case "Accounting"
GetNumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* " - "??_);_(@_)"
Case "Percentage"
GetNumberFormat = "0.00%"
Case Else
GetNumberFormat = "General"
End Select
End Function
What I tried posted. Was expected that the data types for each cell would be preserved, but instead each column gets defaulted to a specific type depending on the first data type that VBA encounters. Need a way to ensure that each cell's data type is preserved.
Best I can suggest is to use VBA to 'scrub' the worksheets so that Access import will accept mixed-data columns. Following is example of quick test on a small range to modify number/date values with apostrophe prefix so they will be treated as string.
Sub FixData()
Dim c As Range
For Each c In Range("A1:A25")
c.Value = "'" & c.Value
Next
End Sub