Help with a data export

I'm needing a little help and/or guidance on making some usable information out of a data export. The export is coming from a scouting management database as a tsv (tab delimited) file that I need to bring into Excel. The problem is that each person in the database is exported as a record with their training courses and completion dates all in the same record (row). The number of courses varies from person to person and I need to be able to filter by a person's name to see what they have completed.

Attached is the native export in tsv format (had to change extension to txt to upload) and an xls file in the format I would like to see that data in.

TIA,
- Brian
SampleExport.txt
DesiredFormat.xls
b_stocktonAsked:
Who is Participating?
 
nutschCommented:
I know, hadn't seen you wanted to keep Alice. Here's an update that will keep the names without training courses:

Sub Macro1()
Const sPath = "C:\Temp\SampleExport.tsv"
Dim lLastRow As Long, lColLoop As Long, rgNames As Range, rgDest As Range

    'turn off updates to speed up code execution
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    Sheets.Add

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & sPath, Destination:=Range _
        ("$A$1"))
        .Name = "SampleExport"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rgNames = Range("A2:F" & lLastRow)
    
    For lColLoop = 9 To ActiveSheet.UsedRange.Columns.Count Step 2
        Set rgDest = Cells(Rows.Count, 1).End(xlUp).Offset(1)
        rgNames.Copy rgDest
        Range(Cells(2, lColLoop), Cells(lLastRow, lColLoop + 1)).Cut rgDest.Offset(0, 6)
    Next lColLoop
    
    
    With Range(Cells(lLastRow, 1), Cells(Rows.Count, 1).End(xlUp).Offset(, 7))
        .AutoFilter
        .AutoFilter field:=7, Criteria1:="="
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
End Sub
                                            

Open in new window

0
 
nutschCommented:
Try the attached code, after updating the constant to your file path:

Sub Macro1()
Const sPath = "C:\Temp\SampleExport.tsv"
Dim lLastRow As Long, lColLoop As Long, rgNames As Range, rgDest As Range

    'turn off updates to speed up code execution
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    Sheets.Add

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & sPath, Destination:=Range _
        ("$A$1"))
        .Name = "SampleExport"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rgNames = Range("A2:F" & lLastRow)
    
    For lColLoop = 9 To ActiveSheet.UsedRange.Columns.Count Step 2
        Set rgDest = Cells(Rows.Count, 1).End(xlUp).Offset(1)
        rgNames.Copy rgDest
        Range(Cells(2, lColLoop), Cells(lLastRow, lColLoop + 1)).Cut rgDest.Offset(0, 6)
    Next lColLoop
    
    
    With Cells(1, 1).CurrentRegion
        .AutoFilter
        .AutoFilter field:=7, Criteria1:="="
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
End Sub

Open in new window


Thomas
0
 
b_stocktonAuthor Commented:
Hello Thomas,

Thank you for the quick response. This code seems to partly work but is dropping the last record "Alice Wonderland" from the results.

- Brian
0
 
b_stocktonAuthor Commented:
Outstanding! That did the trick. I wish I could whip out code like that sometimes. :) Thank you, Thomas for helping out and for the quick turn time.

Thanks,
- Brian
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.