Importing text using macros to identify tags and merge data into columns

I have been struggling with a problem that I hope someone can help me with. (Background: I am a novice at VBA and so please bear with me with some of the more complex syntax)

I have an output (attached txt file) that contains a series of tags for each reference (citaiton). The number of tags may vary from one reference to the next, but will always be preceded by a return carriage (blank line) and end with a return carriage. All tags are CAPITAL letters and contain six characters. The first tag will always be "TY - " and the last tag will always be "ER - " .

What I am trying to do is create a new excel sheet with the information (identified by specific tags) merged into one cell. In the dummy excel sheet (attached) I demonstrate that I want to put in the first column the data from the reference id tag ("ID - ") and in the column next to it a merge of tags ("A1 - ","JF - ","Y1 - "), but without the three backslashes ("///") (i.e. just the year without month or day).

Any ideas will be highly beneficial.

Thanks.

Abousetta

Try this.

Option Explicit

Sub x()
    Dim sFile       As String
    Dim iFF         As Integer
    Dim sInp        As String
    Dim asDat(1 To 3) As String
    Dim iRow        As Long

    sFile = Application.GetOpenFilename("Text files, *.txt")
    If sFile = "False" Then Exit Sub
    
    iFF = FreeFile
    Open sFile For Input As #iFF

    Do While Not EOF(iFF)
        Input #iFF, sInp
        
        Select Case Left(sInp, 6)
            Case "ID  - "
                iRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Cells(iRow, "A").Value = Mid(sInp, 7)
            Case "A1  - "
                asDat(1) = Mid(sInp, 7)
            Case "JF  - "
                asDat(2) = Mid(sInp, 7)
            Case "Y1  - "
                asDat(3) = Replace(Mid(sInp, 7), "/", "")
            Case vbNullString
                If iRow <> 0 Then Cells(iRow, "B").Value = Join(asDat, ", ")
                Erase asDat
        End Select
    Loop

    If IsEmpty(Cells(iRow, "B")) Then Cells(iRow, "B").Value = Join(asDat, ", ")
    Close iFF
End Sub

Untested:

Option Explicit

Sub x()
    Dim sFile       As String
    Dim iFF         As Integer
    Dim sInp        As String
    Dim asDat(1 To 3) As String
    Dim iRow        As Long

    sFile = Application.GetOpenFilename("Text files, *.txt")
    If sFile = "False" Then Exit Sub
    
    iFF = FreeFile
    Open sFile For Input As #iFF

    Do While Not EOF(iFF)
        Input #iFF, sInp
        
        Select Case Left(sInp, 6)
            Case "ID  - "
                iRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Cells(iRow, "A").Value = Mid(sInp, 7)
            
            Case "A1  - "
                If Len(asDat(1)) = 0 Then asDat(1) = Mid(sInp, 7)
            
            Case "JF  - "
                asDat(2) = sInp
            
            Case "JO  - "
                Select Case Left(asDat(2), 6)
                    Case "JA  - ", "J1  - ", "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            
            Case "JA  - "
                Select Case Left(asDat(2), 6)
                    Case "J1  - ", "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            
            Case "J1  - "
                Select Case Left(asDat(2), 6)
                    Case "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            
            Case "J2  - "
                Select Case Left(asDat(2), 6)
                    Case vbNullString
                        asDat(2) = sInp
                End Select
                
            Case "Y1  - "
                asDat(3) = Mid(sInp, 7, 4)
                
            Case vbNullString
                asDat(2) = Mid(asDat(2), 7)
                If iRow <> 0 Then Cells(iRow, "B").Value = Join(asDat, ", ")
                Erase asDat
        End Select
    Loop
    
    If IsEmpty(Cells(iRow, "B")) Then
        asDat(2) = Mid(asDat(2), 7)
        Cells(iRow, "B").Value = Join(asDat, ", ")
    End If

    Close iFF
End Sub

No attachment.

Try this. It uses the TY tag as an indicator of a new entry.

Option Explicit

Sub x()
    Dim sFile       As String
    Dim iFF         As Integer
    Dim sInp        As String
    Dim asDat(1 To 3) As String
    Dim iRow        As Long

    sFile = Application.GetOpenFilename("Text files, *.txt")
    If sFile = "False" Then Exit Sub
    
    iFF = FreeFile
    Open sFile For Input As #iFF

    Do While Not EOF(iFF)
        Input #iFF, sInp
        
        Select Case Left(sInp, 6)
            Case "TY  - "
                asDat(2) = Mid(asDat(2), 7)
                If iRow <> 0 Then Cells(iRow, "B").Value = Join(asDat, ", ")
                Erase asDat
            
            Case "ID  - "
                iRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Cells(iRow, "A").Value = Mid(sInp, 7)
            
            Case "A1  - "
                If Len(asDat(1)) = 0 Then asDat(1) = Mid(sInp, 7)
            
            Case "JF  - "
                asDat(2) = sInp
            
            Case "JO  - "
                Select Case Left(asDat(2), 6)
                    Case "JA  - ", "J1  - ", "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            
            Case "JA  - "
                Select Case Left(asDat(2), 6)
                    Case "J1  - ", "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            
            Case "J1  - "
                Select Case Left(asDat(2), 6)
                    Case "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            
            Case "J2  - "
                Select Case Left(asDat(2), 6)
                    Case vbNullString
                        asDat(2) = sInp
                End Select
                
            Case "Y1  - "
                asDat(3) = Mid(sInp, 7, 4)
                
        End Select
    Loop
    
    If IsEmpty(Cells(iRow, "B")) Then
        asDat(2) = Mid(asDat(2), 7)
        Cells(iRow, "B").Value = Join(asDat, ", ")
    End If
    
    Close iFF
End Sub

You're welcome, glad we got it sorted.

... I was wondering what the function of sInp is? I have seen it used in other macros but can't find an explanation to its use.

It's just the string variable that receives one line of the file from the Input statement.

The data extracted is author (A1), journal (JF, JO, JA, ...), and date (Y1). The T1 tag is not processed at all. In the last example you posted, there is no journal tag, ergo no entry for journal.

abousetta,

Here's a modification to capture all the key words.

The data assembly is getting increasingly random, and begs a completely different approach, like a data-driven grammar. I'm going to leave that to someone else.

Not troublesome at all -- just more requirements creep than I have time for. You did a good job making incremental changes to the code.

By data-driven, grammar-based, I meant something where the row header has strings that provide parsing information that the software can read, to know what tags to collect for the column and how to assemble them. Once implemented, the row headers would control the data assembly entirely, without modifying the code. Columns could be added and deleted at will.

Creating that grammar would require a comprehensive set of cases, a day or so of head-scratching, and then the coding.

Best of luck.