How to copy excel data into multiple notepad file by vba

I have 4 column in my excel data, this is location wise data (Column-A) but I want location wise filter and only Barcode would copy and it has to paste in to notepad there is not limit of bar-codes and it should save in particular location. and it should rename with File Rename Column (Column-B).

Here I am attaching file...

Location wise Data

Output Text File - Result

A               B            C          D
LocationName FileRename Barcode Qty
Box-01  Box-01 108  8905425661077   1
Box-01  Box-01 108  8905425723577   1
Box-01  Box-01 108  8905425652105   1
Box-01  Box-01 108  8905425652969   1
Box-01  Box-01 108  8905425654659   1
Box-01  Box-01 108  8905425654222   1
Box-01  Box-01 108  8905425367504   1
Box-02  Box-02 35   8905425192250   1
Box-02  Box-02 35   8905425190454   1
Box-02  Box-02 35   8905425191475   1
Box-02  Box-02 35   8905425366668   1
Box-02  Box-02 35   8905425204106   1
Box-02  Box-02 35   8905425191819   1
Box-03  Box-03 56   8905425650231   1
Box-03  Box-03 56   8905425652235   1
Box-03  Box-03 56   8905425723133   1
Box-03  Box-03 56   8905425723898   1
Box-03  Box-03 56   8905425650231   1
Box-03  Box-03 56   8905425650156   1
Box-03  Box-03 56   8905425923793   1
Box-03  Box-03 56   8905425652013   1

Thanks & Regards. 7011675525

Solution

Sort source table by the 2nd col before exporting

Microsoft documentation:

Range.Sort method (Excel)

Open statement

Option Explicit

Sub Demo()
    Dim rngData As Range, i As Long, oSht As Worksheet
    Dim arrData, sPath As String, FileNumber As Long
    Const KEY_COL = 2
    Set oSht = Sheets("Sheet1") ' Modify as needed
    sPath = ThisWorkbook.Path & "\"
    With oSht.Range("A1").CurrentRegion
        ' Sort data
        .Sort Key1:=.Columns(KEY_COL), order1:=xlAscending, Header:=xlYes
        Set rngData = .Resize(.Rows.Count + 1)
    End With
    ' Load data into an array
    arrData = rngData.Value
    ' Loop through data
    For i = LBound(arrData) + 1 To UBound(arrData)
        If arrData(i, 2) = arrData(i - 1, 2) Then
            ' Write to txt file
            Print #FileNumber, arrData(i, 3)
        Else
            If FileNumber > 0 Then Close FileNumber
            If Len(arrData(i, 2)) = 0 Then Exit For
            FileNumber = FreeFile
            ' Create a new file
            Open sPath & arrData(i, 2) & ".txt" For Output As FileNumber
        End If
    Next i
    MsgBox "Done"
End Sub

Update:

Option Explicit

Sub Demo()
    Dim rngData As Range, i As Long, oSht As Worksheet
    Dim arrData, sPath As String, FileNumber As Long
    Const KEY_COL = 2
    Set oSht = Sheets("Sheet1") ' Modify as needed
    sPath = ThisWorkbook.Path & "\"
    With oSht.Range("A1").CurrentRegion
        ' Sort data
        .Sort Key1:=.Columns(KEY_COL), order1:=xlAscending, Header:=xlYes
        Set rngData = .Resize(.Rows.Count + 1)
    End With
    ' Load data into an array
    arrData = rngData.Value
    ' Loop through data
    For i = LBound(arrData) + 1 To UBound(arrData)
        If Not arrData(i, 2) = arrData(i - 1, 2) Then
            If FileNumber > 0 Then Close FileNumber
            If Len(arrData(i, 2)) = 0 Then Exit For
            FileNumber = FreeFile
            ' Create a new file
            Open sPath & arrData(i, 2) & ".txt" For Output As FileNumber
        End If
        Print #FileNumber, Trim(arrData(i, 3))
    Next i
    MsgBox "Done"
End Sub