Public Sub subImportCSVFileAndSplit()
Dim arrUnique() As Variant
Dim arrData() As Variant
Dim Wb As Workbook
Dim WsData As Worksheet
Dim i As Integer
Dim strFormula As String
Dim WsExtract As Worksheet
On Error GoTo Err_Handler
ActiveWorkbook.Save
' Import the data from the CSV file and populate the Data worksheet.
Set WsData = fncGetDataFromFile(ActiveWorkbook, "CSV-" & Format(Now(), "DDMMYYYYHHMMSS"))
If WsData Is Nothing Then
MsgBox "No data has been imported.", vbOKOnly, "Warning!"
Exit Sub
End If
Set Wb = ThisWorkbook
' Specify the data range with which to work on.
With WsData.[a1].CurrentRegion.Offset(1)
With .Resize(.Rows.Count, .Columns.Count)
' Put a list of the dates into the arrUnique array.
' Sort into date order ascending.
arrUnique = Evaluate("SORT(UNIQUE('" & WsData.Name & "'!" & .Columns(1).Address & "))")
' Loop through all of the dates.
For i = LBound(arrUnique) To UBound(arrUnique) - 1
' Create a sheet into which to put the data for each date.
Set WsExtract = fncCreateSheet(Wb, Format(arrUnique(i, 1), "DD MMM YYYY"))
' Compile a formula to identify the rows to extract.
strFormula = "VSTACK('" & WsData.Name & "'!" & .Rows(1).Offset(-1).Address & ",FILTER('" & WsData.Name & "'!" & _
.Address & ",'" & WsData.Name & "'!" & .Columns(1).Address & " = " & arrUnique(i, 1) & "))"
' Evaluate the formula and put the data to extract into the arrData array.
arrData = Evaluate(strFormula)
' Write the data from the array to the new sheet created and apply a format
' to the date column.
With WsExtract.Cells(1, 1)
.Resize(UBound(arrData), UBound(arrData, 2)) = arrData
.EntireColumn.NumberFormat = "DD/MM/YYYY"
End With
Next i
End With
End With
ActiveWorkbook.Save
Worksheets(Format(arrUnique(1, 1), "DD MMM YYYY")).Activate
MsgBox "CSV Data Imported and Split into " & i - 1 & " sheets.", vbOKOnly, "Confirmation"
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "There has been any error." & vbCrLf & Err.Number & " " & Err.Description, vbOKCancel, "Warning"
End Sub
' Function to create a new woksheet and return a worksheet object.
' Deletes worksheet by the same name if it already exists.
Private Function fncCreateSheet(Wb As Workbook, strWorksheet As String) As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
Wb.Worksheets(strWorksheet).Delete
On Error GoTo 0
Application.DisplayAlerts = True
Wb.Sheets.Add After:=Wb.Sheets(Wb.Sheets.Count)
ActiveSheet.Name = strWorksheet
Set fncCreateSheet = ActiveSheet
End Function
' Function to get data from a CSV and populate a worksheet as specifed
' by the workbook object and worksheet name passed as parameters.
Public Function fncGetDataFromFile(Wb As Workbook, strWorksheet As String) As Worksheet
Dim strFileToOpen As Variant
Dim WbOpenBook As Workbook
Dim Ws As Worksheet
strFileToOpen = Application.GetOpenFilename(Title:="Browse for your CSV File.", FileFilter:="CSV Files (*.csv*),*csv*")
If strFileToOpen <> False Then
Set Ws = fncCreateSheet(Wb, strWorksheet)
Set WbOpenBook = Application.Workbooks.Open(strFileToOpen)
WbOpenBook.Sheets(1).Range("A1").CurrentRegion.Copy
Ws.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
WbOpenBook.Close False
Ws.Range("A1").Select
Set fncGetDataFromFile = Ws
End If
End Function
