I want to generate a sorted data and save a .txt file by group base of the Area Codes on the account number.
Example data:
17 is one of the many area codes.
The remaining numbers are the account number.
Sample Data
When generating files, this code saves all of the data separately and not by group base on the area code of the Account number:
Set dict = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set dataRange = ws.Range("A5:J" & lastRow)
For Each cell In dataRange
paymentNum = Left(cell.Value, 2)
If dict.Exists(paymentNum) Then
dict(paymentNum) = dict(paymentNum) & vbCrLf & cell.Value
Else
dict.Add paymentNum, cell.Value
End If
Next cell
Set sortedKeys = CreateObject("System.Collections.ArrayList")
For Each key In dict.Keys
sortedKeys.Add key
Next key
sortedKeys.Sort
For Each key In sortedKeys
fileName = "Group_" & key & ".txt"
Open fileName For Output As #1
Print #1, dict(key)
Close #1
Next key
MsgBox "Groups saved as text files.", vbInformation
End Sub
This is the result:
Sample Result of my code
Sample Generated Output
It didn't save the data correctly.
This is the result that I'm hoping to achieve:
sample result
Microsoft documentation:
Option Explicit
Sub Demo()
Dim objDic As Object, rngData As Range
Dim i As Long, j As Long, sKey As String
Dim arrData, sFilename As String
Dim lastRow As Long, oSht As Worksheet
Dim iFile As Long, sTxt As String
Set oSht = ActiveSheet ' modify as needed
' get last row#
lastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
Set rngData = oSht.Range("A5", "J" & lastRow)
' sort table
rngData.Sort Key1:=rngData.Columns(1), Order1:=xlAscending, Header:=xlNo
arrData = rngData.Value
Set objDic = CreateObject("scripting.dictionary")
' loop through data
For i = LBound(arrData) To UBound(arrData)
' get area code
sKey = Left(arrData(i, 1), 2)
If Not objDic.exists(sKey) Then
sFilename = ThisWorkbook.Path & "\Group_" & sKey & ".txt"
If iFile > 0 Then Close #iFile ' colse text file
iFile = FreeFile
Open sFilename For Output As #iFile ' open a new text file
objDic(sKey) = ""
End If
' concate data in a row
For j = 1 To UBound(arrData, 2)
sTxt = sTxt & vbTab & arrData(i, j)
Next
' write data to text file
Print #iFile, Mid(sTxt, 2)
sTxt = ""
Next i
If iFile > 0 Then Close #iFile
End Sub