T4713_Export Each Branch To Text File

https://excel-egy.com/forum/t4713
---------------------------------

Sub Export_Each_Branch_To_Text_File()
    Dim sPath$, s$, txt$, i%, r&, c&

    sPath = ThisWorkbook.Path & "\Output Files\"
    If Len(Dir(sPath, vbDirectory)) = 0 Then MkDir sPath

    For c = 3 To 16
        txt = Empty: s = Empty
        For r = 4 To Cells(Rows.Count, 1).End(xlUp).Row
            If Trim(Cells(r, c).Value) <> "" Then
                s = Cells(r, 1).Value & ", " & Cells(r, c).Value
                txt = txt & IIf(txt = Empty, Empty, vbNewLine) & s
            End If
        Next r

        If txt <> Empty Then
            Open sPath & Cells(3, c).Value & ".txt" For Output As #1
            Print #1, txt
            Close #1
        End If
    Next c

    MsgBox "The Text Files Can Be Found In " & sPath, 64, "Complete"
End Sub