Sub LoadFile2()
Const ForReading As Integer = 1
Dim varFileName, avarData, varData
Dim lngRow As Long, lngColumnCount As Long, lngIndex As Long, lngRecCount As Long
Dim x As Long, y As Long
Dim fso As Object, tsrStream1 As Object
Dim shtNew As Worksheet
Set shtNew = ActiveWorkbook.Sheets.Add
varFileName = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "Select source file")
If TypeName(varFileName) = "Boolean" Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
lngRow = 1
Set tsrStream1 = fso.OpenTextFile(varFileName, ForReading, False)
avarData = Split(tsrStream1.ReadAll, vbCrLf)
tsrStream1.Close
Application.ScreenUpdating = False
For lngIndex = LBound(avarData) To UBound(avarData)
If Len(avarData(lngIndex)) > 0 Then
varData = GetRowData(CStr(avarData(lngIndex)))
lngRecCount = UBound(varData, 1)
lngColumnCount = UBound(varData, 2)
shtNew.Cells(lngRow, "A").Resize(lngRecCount, lngColumnCount).Value = varData
lngRow = lngRow + lngRecCount
End If
Next lngIndex
Application.ScreenUpdating = True
End Sub
Function GetRowData(strIn As String) As Variant
Dim varData, varRecs
Dim avarOutput()
Dim lngRecCount As Long
Dim x As Long, y As Long
varData = Split(strIn, ",")
' get rec count from second field
varRecs = Split(varData(1), ";")
lngRecCount = 0
For x = LBound(varRecs) To UBound(varRecs)
If Len(varRecs(x)) > 0 Then lngRecCount = lngRecCount + 1
Next x
If lngRecCount = 0 Then lngRecCount = 1
ReDim avarOutput(1 To lngRecCount, 1 To UBound(varData) + 1)
' now iterate the row data
For x = LBound(varData) To UBound(varData)
If InStr(varData(x), ";") > 0 Then
varRecs = Split(varData(x), ";")
For y = 1 To lngRecCount
avarOutput(y, x + 1) = varRecs(y - 1)
Next y
Else
For y = 1 To lngRecCount
avarOutput(y, x + 1) = varData(x)
Next y
End If
Next x
GetRowData = avarOutput
End Function
Function GetRowData(strIn As String) As Variant
Dim varData, varRecs
Dim avarOutput()
Dim lngRecCount As Long
Dim x As Long, y As Long
varData = Split(strIn, "}")
' get rec count from second field
varRecs = Split(varData(1), ";")
lngRecCount = 0
For x = LBound(varRecs) To UBound(varRecs)
If Len(varRecs(x)) > 0 Then lngRecCount = lngRecCount + 1
Next x
If lngRecCount = 0 Then lngRecCount = 1
ReDim avarOutput(1 To lngRecCount, 1 To UBound(varData) + 1)
' now iterate the row data
For x = LBound(varData) To UBound(varData)
If InStr(varData(x), ";") > 0 Then
varRecs = Split(varData(x), ";")
If lngRecCount > UBound(varRecs) + 1 Then lngRecCount = UBound(varRecs) + 1
For y = 1 To lngRecCount
avarOutput(y, x + 1) = varRecs(y - 1)
Next y
Else
For y = 1 To lngRecCount
avarOutput(y, x + 1) = varData(x)
Next y
End If
Next x
GetRowData = avarOutput
End Function
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Excel 2016 vba task to have certain column appear in certain rows | 20 | 28 | |
Excel VBA Find Lowest Row number in any selection | 8 | 26 | |
Runtime Error 9 - Subscript out of Range (Check to see if Sheet Exists) | 14 | 25 | |
excel count months in date range | 6 | 14 |
Join the community of 500,000 technology professionals and ask your questions.