Background
The CSV files being used can be 6+ mill records in size, using a small sample size to proof the methodology.
Why are you doing this on excel? Access or SQL would be quicker
My company has disabled the VBE for anyone who is not recognised as a developer (progressive, I know.....).
I want to submit a third party macro & be recognised as a developer to continue building small applications when native tools do not fulfil my needs.
Objective
- Import two CSV files & add to respective arrays for comparison (attached for reference)
- Files contain account & unit balance data (dummy data for this example)
- Consolidate records onto the 'original' array
- If a record from the 'original' file is also on the 'external' file, the units from the 'external' file should be added to the corresponding record on the 'original' file.
- Output a CSV file with double quote text qualifiers & ";" delimiters.
I have compiled the below code to complete but really appreciate any feedback on how to optimise given the size of the data that will be used.
Sub Import_Files_Create_Consolidated_File()
Const txtFilepath = "C:\Users\jason\OneDrive\Desktop\VBA_Folder\Macros\Balance_Consolidation\"
Dim arrOrig, arrExt As Variant
Dim i, j, n, n2, x As Long
Dim joinOrig, joinExt, strTempArray1d, strTempArray1dExt As String
Dim FSOreadOrigBal As Object: Set FSOreadOrigBal = CreateObject("Scripting.FileSystemObject")
Dim FSOreadExtBal As Object: Set FSOreadExtBal = CreateObject("Scripting.FileSystemObject")
Dim FSOcreatetxt As Object: Set FSOcreatetxt = CreateObject("Scripting.FileSystemObject")
'I move output file to later in the procedure after err handling is finished
Dim outputFile As Object: Set outputFile = FSOcreatetxt.CreateTextFile(txtFilepath & "Output.csv", True)
Dim fdImportOrigBal As FileDialog: Set fdImportOrigBal = Application.FileDialog(msoFileDialogFilePicker)
Dim fdImportExtBal As FileDialog: Set fdImportExtBal = Application.FileDialog(msoFileDialogFilePicker)
Dim strOrigBal, strExtBal As String
Dim tempArray1d, tempArray1dExt, finalArrayOrig2d, finalArrayExt2d As Variant
'Allow the user to select their input files, Enter err handling later
With fdImportOrigBal
.Filters.Clear
.Filters.Add "CSV files", "*.CSV*"
.Title = "Select original balance file"
.AllowMultiSelect = False
.InitialFileName = txtFilepath
.Show
End With
strOrigBal = fdImportOrigBal.SelectedItems(1)
Set FSOreadOrigBal = FSOreadOrigBal.OpenTextFile(strOrigBal, 1)
With fdImportExtBal
.Filters.Clear
.Filters.Add "CSV files", "*.CSV*"
.Title = "Select external balance file"
.AllowMultiSelect = False
.InitialFileName = txtFilepath
.Show
End With
strExtBal = fdImportExtBal.SelectedItems(1)
Set FSOreadExtBal = FSOreadExtBal.OpenTextFile(strExtBal, 1)
'Compile both files into a 1d array
arrOrig = Split(FSOreadOrigBal.ReadAll, vbNewLine)
arrExt = Split(FSOreadExtBal.ReadAll, vbNewLine)
'So I want to check if an item is on the external array but not on the original array_
'If not found, move the item from the external array & add to the original array_
'Important that the item just moved is deleted from the external array, otherwise it will incorrectly sum the units when_
'we complete this check
'I will need to only use the first 4 columns for the unique key, as units will differ even if on both external & original arrays.
ReDim tempArray1d(UBound(arrOrig))
'Create unique key on original array & pass it to a temp array
For n = LBound(arrOrig, 1) + 1 To UBound(arrOrig, 1)
tempArray1d(n) = Split(arrOrig(n), ",")(0) & Split(arrOrig(n), ",")(1) & Split(arrOrig(n), ",")(2) & Split(arrOrig(n), ",")(3)
Next n
ReDim tempArray1dExt(UBound(arrExt))
'Create unique key on original array & pass it to a temp array_
'Using a UDF & unique key, search the temp original array to find the record from the external array_
'If not found, resize original array & add the record which has not been found.
For n = LBound(arrExt, 1) + 1 To UBound(arrExt, 1)
tempArray1dExt(n) = Split(arrExt(n), ",")(0) & Split(arrExt(n), ",")(1) & Split(arrExt(n), ",")(2) & Split(arrExt(n), ",")(3)
strTempArray1dExt = tempArray1dExt(n)
'Credit function - https://stackoverflow.com/questions/38267950/check-if-a-value-is-in-an-array-or-not-with-excel-vba
If IsInArray(strTempArray1dExt, tempArray1d) = False Then
ReDim Preserve arrOrig(UBound(arrOrig) + 1)
arrOrig(UBound(arrOrig)) = arrExt(n)
arrExt(n) = ""
End If
Next n
'Now I want to resize my array before making a 2d array by removing the blank indexes
ReDim tempArray1dExt(0)
For n = LBound(arrExt, 1) To UBound(arrExt, 1)
'Write non blank rows to a different temp array & then resize & write back to arrExt
If arrExt(n) <> "" Then
tempArray1dExt(UBound(tempArray1dExt)) = arrExt(n)
ReDim Preserve tempArray1dExt(UBound(tempArray1dExt) + 1)
End If
Next n
ReDim arrExt(UBound(tempArray1dExt) - 1)
For n = LBound(tempArray1dExt, 1) To UBound(tempArray1dExt, 1) - 1
arrExt(n) = tempArray1dExt(n)
Next n
'Create the template for my final 2d array, will be used to write to a CSV output
ReDim finalArrayOrig2d(UBound(arrOrig), 4)
For n = LBound(arrOrig, 1) To UBound(arrOrig, 1)
tempArray1d = Split(arrOrig(n), ",")
For n2 = 0 To 4
finalArrayOrig2d(n, n2) = tempArray1d(n2)
Next n2
Next n
'Create the template for my final 2d external array, will be used to sum units if unique key is found
ReDim finalArrayExt2d(UBound(arrExt), 4)
For n = LBound(arrExt, 1) To UBound(arrExt, 1)
tempArray1d = Split(arrExt(n), ",")
For n2 = 0 To 4
finalArrayExt2d(n, n2) = tempArray1d(n2)
Next n2
Next n
'Change data type to double in final arrays for units addition
For i = LBound(finalArrayOrig2d, 1) + 1 To UBound(finalArrayOrig2d, 1)
finalArrayOrig2d(i, 4) = CDbl(finalArrayOrig2d(i, 4))
Next i
For i = LBound(finalArrayExt2d, 1) + 1 To UBound(finalArrayExt2d, 1)
finalArrayExt2d(i, 4) = CDbl(finalArrayExt2d(i, 4))
Next i
'Enter a loop to determine if there is a match & add units if there is
For i = LBound(finalArrayOrig2d, 1) + 1 To UBound(finalArrayOrig2d, 1)
joinOrig = Join(Array(finalArrayOrig2d(i, 0), finalArrayOrig2d(i, 1), finalArrayOrig2d(i, 2), finalArrayOrig2d(i, 3)))
'Enter external balance file & compile unique key
For j = LBound(finalArrayExt2d, 1) + 1 To UBound(finalArrayExt2d, 1)
joinExt = Join(Array(finalArrayExt2d(j, 0), finalArrayExt2d(j, 1), finalArrayExt2d(j, 2), finalArrayExt2d(j, 3)))
'Add units here is a match
If joinOrig = joinExt Then
finalArrayOrig2d(i, 4) = finalArrayOrig2d(i, 4) + finalArrayExt2d(j, 4)
End If
Next j
Next i
'Wrap final array in double quote text qualifiers
For i = LBound(finalArrayOrig2d, 1) To UBound(finalArrayOrig2d, 1)
For j = LBound(finalArrayOrig2d, 2) To UBound(finalArrayOrig2d, 2)
finalArrayOrig2d(i, j) = """" & finalArrayOrig2d(i, j) & """"
Next j
Next i
'Write the updated original array to a CSV file
For n = LBound(finalArrayOrig2d, 1) To UBound(finalArrayOrig2d, 1)
outputFile.WriteLine Join(Array(finalArrayOrig2d(n, 0), finalArrayOrig2d(n, 1), finalArrayOrig2d(n, 2), finalArrayOrig2d(n, 3), finalArrayOrig2d(n, 4)), ";")
Next n
End Sub
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i As Long
For i = LBound(arr) To UBound(arr)
If arr(i) = stringToBeFound Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False
End Function