Using Type Record Structures In Excel VBA
The following code demonstrates how to create data structures in Excel using the Type statement.
Program Code
Option Explicit
' ************************************************
' Workbook/Worksheet Assignments
' ************************************************
Dim wkbAdagioImportTemplate As Workbook
Dim wksAdagioImportData As Worksheet
Dim wksAdagioItemNumberTranslation As Worksheet
Dim wkbNexternalExport As Workbook
Dim wksNexternalOrders As Worksheet
Dim wksNexternalLineItems As Worksheet
Dim wksNexternalCustomers As Worksheet
Dim strFilePathToRawData As String
Dim strImportedNexternalWorkbook As String
Dim dlgOpenFile As FileDialog
Dim lngLastRowOfOrders As Long
Dim lngLastRowOfLineItems As Long
Dim lngLastRowOfCustomers As Long
Dim lngAdagioTemplateActiveRow As Long
Dim lngLastRowOfItemNumberTranslation As Long
Dim strLastOrder As String
Dim strSaveAsName As String
Dim i As Long
Dim d As Long
Dim C As Range
Dim rngItemNumberTranslation As Range
Public Type AdagioRecordTypeH
strRecordType As String
strCustomerNumber As String
strOrderNumberWithPreamble As String
strOrderNumber As String
dteDate As Date
strShippingMethod As String
strTrackingNumber As String
strDropShip As String
strOrderNote As String
strState As String
strTransactionID As String
dblTotalInvoiceAmount As Double
End Type
Type AdagioRecordTypeS
strRecordType As String
strContact As String
strCompanyName As String
strStreetAddress1 As String
strStreetAddress2 As String
strCityState As String
strZipCode As String
strPhoneNumber As String
End Type
Type AdagioRecordTypeM
strRecordType As String
strShippingIndicator As String
dblShippingCharge As Double
End Type
Type AdagioRecordTypeD
strRecordType As String
strItemNumber As String
lngQuantityOrdered As Long
dblPriceEach As Double
End Type
Public Sub ConvertNexternalToAdagio()
Dim TypeH As AdagioRecordTypeH
Dim TypeS As AdagioRecordTypeS
Dim TypeM As AdagioRecordTypeM
Dim TypeD As AdagioRecordTypeD
Set wkbAdagioImportTemplate = ThisWorkbook
Set wksAdagioImportData = wkbAdagioImportTemplate.Sheets("AdagioImport")
Set wksAdagioItemNumberTranslation = wkbAdagioImportTemplate.Sheets("ItemNumberTranslation")
wksAdagioImportData.Range(wksAdagioImportData.Cells(1, 1), wksAdagioImportData.Cells(30000, 50)).ClearContents
lngAdagioTemplateActiveRow = 0
' *******************************************************
' Open Nexternal Export Data
' *******************************************************
strFilePathToRawData = ""
Set dlgOpenFile = Application.FileDialog(msoFileDialogOpen)
With dlgOpenFile
.Title = "Select Nexternal Export Excel File"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel File", "*.xlsx"
.FilterIndex = 1
.Show
If .SelectedItems.Count < 1 Then
MsgBox ("No File Selected")
Exit Sub
End If
strFilePathToRawData = .SelectedItems(1)
End With
' ************************************************
' Check for Valid Path - If Valid then save
' The Workbook Name and Open It
' ************************************************
If strFilePathToRawData = "" Then
MsgBox ("No File Selected")
Exit Sub
End If
Workbooks.Open strFilePathToRawData
' ************************************************
' Register the External Workbook To Be Imported
' ************************************************
Set wkbNexternalExport = ActiveWorkbook
Set wksNexternalOrders = wkbNexternalExport.Sheets("Orders")
Set wksNexternalLineItems = wkbNexternalExport.Sheets("Line Items")
Set wksNexternalCustomers = wkbNexternalExport.Sheets("Customers")
strImportedNexternalWorkbook = ActiveWorkbook.Name
' ************************************************
' Validate the correct workbook was opened
' ************************************************
If wksNexternalLineItems.Cells(1, 1) <> "ORDER_NO" Then
MsgBox ("File Format Does Not Agree With Expected Format" & vbCrLf & "Import Cancelled")
wkbNexternalExport.Close SaveChanges:=False
Exit Sub
End If
' ************************************************
' Locate Last Orders Record
' ************************************************
lngLastRowOfOrders = wksNexternalOrders.Cells(wksNexternalOrders.Rows.Count, "A").End(xlUp).Row
' ************************************************
' Locate Last Line Item Record
' ************************************************
lngLastRowOfLineItems = wksNexternalLineItems.Cells(wksNexternalLineItems.Rows.Count, "A").End(xlUp).Row
' ************************************************
' Locate Last Customers Record
' ************************************************
lngLastRowOfCustomers = wksNexternalCustomers.Cells(wksNexternalCustomers.Rows.Count, "A").End(xlUp).Row
' ************************************************
' Locate Last Row Of Item Number Translation
' ************************************************
lngLastRowOfItemNumberTranslation = wksAdagioItemNumberTranslation.Cells(wksAdagioItemNumberTranslation.Rows.Count, "A").End(xlUp).Row
' ************************************************
' Set Search Range For Item Number Translation
' ************************************************
Set rngItemNumberTranslation = Range(wksAdagioItemNumberTranslation.Cells(2, 1), wksAdagioItemNumberTranslation.Cells(lngLastRowOfItemNumberTranslation, 1))
' ************************************************
' Loop Through Each Order
' ************************************************
Application.ScreenUpdating = False
For i = 2 To lngLastRowOfOrders
' ************************************************************************************************
' Format H Record
' ************************************************************************************************
strLastOrder = wksNexternalOrders.Cells(i, 1)
TypeH.strRecordType = "H"
TypeH.strCustomerNumber = GetCustomerNumber(wksNexternalOrders.Cells(i, "D"))
TypeH.strOrderNumberWithPreamble = "Nexternal " & wksNexternalOrders.Cells(i, "A")
TypeH.strOrderNumber = wksNexternalOrders.Cells(i, "A")
TypeH.dteDate = wksNexternalOrders.Cells(i, "B")
TypeH.strShippingMethod = GetShippingMethod(strLastOrder)
TypeH.strTrackingNumber = GetTrackingNumber(strLastOrder)
TypeH.strDropShip = "No"
TypeH.strOrderNote = wksNexternalOrders.Cells(i, "AJ")
TypeH.strState = GetState(strLastOrder)
TypeH.strTransactionID = String(31, "X") & wksNexternalOrders.Cells(i, "X")
TypeH.dblTotalInvoiceAmount = wksNexternalOrders.Cells(i, "H")
lngAdagioTemplateActiveRow = lngAdagioTemplateActiveRow + 1
Call FormatAdagioHRecord
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A") = TypeH.strRecordType
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B") = TypeH.strCustomerNumber
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C") = TypeH.strOrderNumberWithPreamble
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "D") = TypeH.strOrderNumber
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "E") = TypeH.dteDate
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "F") = TypeH.strShippingMethod
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "G") = TypeH.strTrackingNumber
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "H") = TypeH.strDropShip
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "I") = TypeH.strOrderNote
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "J") = TypeH.strState
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "K") = TypeH.strTransactionID
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "L") = TypeH.dblTotalInvoiceAmount
' ************************************************************************************************
' Format S Record
' ************************************************************************************************
TypeS.strRecordType = "S"
TypeS.strContact = GetContact(strLastOrder)
TypeS.strCompanyName = GetCompanyName(strLastOrder)
TypeS.strStreetAddress1 = GetStreetAddress1(strLastOrder)
TypeS.strStreetAddress2 = GetStreetAddress2(strLastOrder)
TypeS.strCityState = GetCityState(strLastOrder)
TypeS.strZipCode = GetZipCode(strLastOrder)
TypeS.strPhoneNumber = GetPhoneNumber(strLastOrder)
lngAdagioTemplateActiveRow = lngAdagioTemplateActiveRow + 1
Call FormatAdagioSRecord
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A") = TypeS.strRecordType
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B") = TypeS.strContact
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C") = TypeS.strCompanyName
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "D") = TypeS.strStreetAddress1
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "E") = TypeS.strStreetAddress2
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "F") = TypeS.strCityState
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "G") = TypeS.strZipCode
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "H") = TypeS.strPhoneNumber
' ************************************************************************************************
' Format M Record
' ************************************************************************************************
TypeM.strRecordType = "M"
TypeM.strShippingIndicator = "1"
TypeM.dblShippingCharge = GetShippingCharge(strLastOrder)
lngAdagioTemplateActiveRow = lngAdagioTemplateActiveRow + 1
Call FormatAdagioMRecord
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A") = TypeM.strRecordType
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B") = TypeM.strShippingIndicator
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C") = TypeM.dblShippingCharge
' ************************************************************************************************
' Format D Records
' ************************************************************************************************
For d = 2 To lngLastRowOfLineItems
If strLastOrder <> CStr(wksNexternalLineItems.Cells(d, "A")) Then
GoTo GetNextItem
End If
If Left(wksNexternalLineItems.Cells(d, "B"), 9) = "Sales Tax" Or _
Left(wksNexternalLineItems.Cells(d, "B"), 8) = "Shipping" Then
GoTo GetNextItem
End If
TypeD.strRecordType = "D"
TypeD.strItemNumber = GetAdagioItemNumber(wksNexternalLineItems.Cells(d, "C"))
TypeD.lngQuantityOrdered = wksNexternalLineItems.Cells(d, "E")
TypeD.dblPriceEach = wksNexternalLineItems.Cells(d, "D")
lngAdagioTemplateActiveRow = lngAdagioTemplateActiveRow + 1
Call FormatAdagioDRecord
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A") = TypeD.strRecordType
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B") = TypeD.strItemNumber
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C") = TypeD.lngQuantityOrdered
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "D") = TypeD.dblPriceEach
GetNextItem:
Next d
' ************************************************************************************************
' Get Next Order Number
' ************************************************************************************************
Next i
wkbAdagioImportTemplate.Activate
wkbNexternalExport.Close SaveChanges:=False
' ********************************************************
' Save the CSV File With A Unique Date and Time Stamp
' ********************************************************
strSaveAsName = CurDir() & "\" & "AdagioImportFileFromNexternal_" & Format(Date, "YYYY_MM_DD") & "_" & Format(Hour(Now), "00") & Format(Minute(Now), "00")
Application.DisplayAlerts = False
wksAdagioImportData.Copy
ActiveWorkbook.SaveAs Filename:=strSaveAsName, FileFormat:=xlCSV
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("The Report Was Saved to " & strSaveAsName)
End Sub
Private Function GetCustomerNumber(strCustomerNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfCustomers
If strCustomerNumber = CStr(wksNexternalCustomers.Cells(j, "A")) Then
GetCustomerNumber = wksNexternalCustomers.Cells(j, "AA")
Exit Function
End If
Next j
GetCustomerNumber = "NotFound"
End Function
Private Function GetShippingMethod(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetShippingMethod = wksNexternalLineItems.Cells(j, "AA")
Exit Function
End If
Next j
GetShippingMethod = "NotFound"
End Function
Private Function GetTrackingNumber(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetTrackingNumber = wksNexternalLineItems.Cells(j, "AG")
Exit Function
End If
Next j
GetTrackingNumber = "NotFound"
End Function
Private Function GetState(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetState = wksNexternalLineItems.Cells(j, "W")
Exit Function
End If
Next j
GetState = "NotFound"
End Function
Private Function GetContact(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetContact = wksNexternalLineItems.Cells(j, "O") & ", " & wksNexternalLineItems.Cells(j, "P")
Exit Function
End If
Next j
GetContact = "NotFound"
End Function
Private Function GetCompanyName(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetCompanyName = wksNexternalLineItems.Cells(j, "S")
Exit Function
End If
Next j
GetCompanyName = "NotFound"
End Function
Private Function GetStreetAddress1(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetStreetAddress1 = wksNexternalLineItems.Cells(j, "T")
Exit Function
End If
Next j
GetStreetAddress1 = "NotFound"
End Function
Private Function GetStreetAddress2(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetStreetAddress2 = wksNexternalLineItems.Cells(j, "U")
Exit Function
End If
Next j
GetStreetAddress2 = "NotFound"
End Function
Private Function GetCityState(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetCityState = wksNexternalLineItems.Cells(j, "V") & ", " & wksNexternalLineItems.Cells(j, "W")
Exit Function
End If
Next j
GetCityState = "NotFound"
End Function
Private Function GetZipCode(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
GetZipCode = wksNexternalLineItems.Cells(j, "X")
Exit Function
End If
Next j
GetZipCode = "NotFound"
End Function
Private Function GetPhoneNumber(strOrderNumber) As String
Dim j As Long
For j = 2 To lngLastRowOfLineItems
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
If wksNexternalLineItems.Cells(j, "R") = "" Then
GetPhoneNumber = CStr(wksNexternalLineItems.Cells(j, "Q"))
Exit Function
Else
GetPhoneNumber = CStr(wksNexternalLineItems.Cells(j, "Q")) & " X" & CStr(wksNexternalLineItems.Cells(j, "R"))
Exit Function
End If
End If
Next j
GetPhoneNumber = "NotFound"
End Function
Private Function GetShippingCharge(strOrderNumber) As String
Dim j As Long
Dim k As Long
For j = 2 To lngLastRowOfLineItems
' ************************************************
' Locate the first matching order number in the
' stream of transactions, and then search within
' that matching stream until a shipping charge
' is found
' ************************************************
If strOrderNumber = CStr(wksNexternalLineItems.Cells(j, "A")) Then
k = j
Do
If Left(wksNexternalLineItems.Cells(k, "B"), 8) = "Shipping" Then
GetShippingCharge = wksNexternalLineItems.Cells(k, "F")
Exit Function
End If
k = k + 1
Loop Until strOrderNumber <> CStr(wksNexternalLineItems.Cells(k, "A"))
GetShippingCharge = "NotFound"
Exit Function
End If
Next j
GetShippingCharge = "NotFound"
End Function
Private Sub FormatAdagioHRecord()
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "D").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "E").NumberFormat = "YYYY-MM-DD"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "F").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "G").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "H").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "I").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "J").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "K").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "L").NumberFormat = "0.00"
End Sub
Private Sub FormatAdagioSRecord()
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "D").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "E").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "F").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "G").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "H").NumberFormat = "@"
End Sub
Private Sub FormatAdagioMRecord()
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C").NumberFormat = "0.00"
End Sub
Private Sub FormatAdagioDRecord()
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "A").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "B").NumberFormat = "@"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "C").NumberFormat = "0"
wksAdagioImportData.Cells(lngAdagioTemplateActiveRow, "D").NumberFormat = "0.00"
End Sub
Private Function GetAdagioItemNumber(ItemNumber As String) As String
For Each C In rngItemNumberTranslation
If ItemNumber = C.Value Then
GetAdagioItemNumber = C.Offset(0, 1).Value
Exit Function
End If
Next C
GetAdagioItemNumber = ItemNumber
End Function