Create .TXT Subsets based on existing Excel data using VBA Macro

[Rakesh99932]

Hello Guys,
I need to create Subsets for the data which I have, which is dynamic, using Excel VBA.
I have data in the form of table, whose column headings are Code, % & Transaction ID as the below table.

Code​	%​	Transaction ID​
1001​	42.10%​	455152​
1001​	42.10%​	455153​
1001​	42.10%​	455154​
1001​	55.10%​	455155​
1001​	55.10%​	455156​
1001​	55.10%​	455157​
1002​	66.40%​	455158​
1002​	66.40%​	455159​
1002​	66.40%​	455160​
1002​	66.40%​	455161​
1002​	85.70%​	455162​
1003​	85.70%​	455163​
1003​	85.70%​	455164​
1003​	85.70%​	455165​
1003​	85.70%​	455166​
1004​	95.60%​	455167​
1004​	95.60%​	455168​
1004​	95.60%​	455169​
1004​	95.60%​	455170​
1004​	95.60%​	455171​

I need to create subsets in .txt file which only shows Transaction ID's in it based on the combinations between Code and %.

For example, if I filter Code 1001, I can see 42.10% & 55.10%. For the first combination of code 1001 & 42.10%, the transaction ID’s only should be copied to a .txt file and this .txt file should be saved with the naming convection using “TXT_Code%_ddmm” format.

Example of the combinations:

Example 1:

Code​	%​	Transaction ID​
1001​	42.10%​	455152​
1001​	42.10%​	455153​
1001​	42.10%​	455154​

In the above table, i have filtered 1001 Code and 42.10%. I need transaction Id’s only should be copied to a new .txt file, and its naming convection should be as “TXT_1001421_ddmm” format and save this .Txt file in the folder.

Example 2:

Code​	%​	Transaction ID​
1001​	55.10%​	455155​
1001​	55.10%​	455156​
1001​	55.10%​	455157​

In the above table, i have filtered 1001 Code and 55.10%. I need transaction Id’s only should be copied to a new .txt file, and its naming convection should be as “TXT_1001551_ddmm” format and save this file in the folder.

The data is always dynamic and the combinations are also dynamic.

Request your kind help in this matter, as this will save lo of time for the huge data I have.

Thank you for your help in Advance.

 

[Norie]

1 You can modify the folder in the code here, but I can also post code to allow the user to select the folder.

    strPath = "C:\Test\"

2 I'm not sure I fully understand and/or I'm not exactly sure how you want the values to appear in the filename, could you explain further?

 

[Rakesh99932]

1 You can modify the folder in the code here, but I can also post code to allow the user to select the folder.

    strPath = "C:\Test\"

2 I'm not sure I fully understand and/or I'm not exactly sure how you want the values to appear in the filename, could you explain further?

I am looking for the file name to be in this format:

Example: For the table below

CODE	%	TransactionID
1020	89.9 %	12345
1020	100.00 %	32459

As we have 2 codes and 2 %'s in the above table. The final Txt outcome should have the below name format.
1. TXT_1020899 - 1020 is the code and 899 is nothing but the percentage value
2. TXT_1020100 1020 is the code and 100 is nothing but the percentage value

Please let me know if this clarifies.

 

[yinkajewole]

but this my code is working perfectly from my end here

Sub subsetTestAuto()
Dim s$, c&, j, id$, dd, d() As String, sel As Boolean, folder$, fol As FileDialog, z, b$, i&, p&
Dim h() As String, t&, per$

Set fol = Application.FileDialog(msoFileDialogFolderPicker)
fol.AllowMultiSelect = False
sel = fol.Show
If sel Then folder = fol.SelectedItems(1) & "\" Else Exit Sub
j = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
For dd = 1 To j
If InStr(1, dn, Cells(dd, 1), vbTextCompare) = 0 Then
dn = dn & "|" & Cells(dd, 1)
c = Cells(dd, 1)
For z = 1 To j
If Cells(z, 1) = c Then
If InStr(1, b, Cells(z, 2)) > 0 Then
Else
If b = "" Then b = Cells(z, 2) Else b = b & "|" & Cells(z, 2)
End If
End If
Next z
d = Split(b, "|", , vbTextCompare)
For i = 0 To UBound(d)
For p = 1 To j
If Cells(p, 1) = c And Cells(p, 2) = d(i) Then
If id = "" Then id = Cells(p, 3) Else id = id & vbNewLine & Cells(p, 3)

h = Split(CDec(Cells(p, 2)) * 100, ".", , vbTextCompare)
End If
Next p

For t = 0 To UBound(h)
If IsNumeric(h(t)) Then
If per = "" Then per = h(t) Else per = per & h(t)
End If
Next

Open folder & "TXT_" & c & per & " " & c & ".txt" For Output As #1
Print #1, id;
Close #1
id = "": per = "": b = ""
Next i
End If
Next dd
End Sub

 

[Rakesh99932]

but this my code is working perfectly from my end here

Sub subsetTestAuto()
Dim s$, c&, j, id$, dd, d() As String, sel As Boolean, folder$, fol As FileDialog, z, b$, i&, p&
Dim h() As String, t&, per$

Set fol = Application.FileDialog(msoFileDialogFolderPicker)
fol.AllowMultiSelect = False
sel = fol.Show
If sel Then folder = fol.SelectedItems(1) & "\" Else Exit Sub
j = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
For dd = 1 To j
If InStr(1, dn, Cells(dd, 1), vbTextCompare) = 0 Then
dn = dn & "|" & Cells(dd, 1)
c = Cells(dd, 1)
For z = 1 To j
If Cells(z, 1) = c Then
If InStr(1, b, Cells(z, 2)) > 0 Then
Else
If b = "" Then b = Cells(z, 2) Else b = b & "|" & Cells(z, 2)
End If
End If
Next z
d = Split(b, "|", , vbTextCompare)
For i = 0 To UBound(d)
For p = 1 To j
If Cells(p, 1) = c And Cells(p, 2) = d(i) Then
If id = "" Then id = Cells(p, 3) Else id = id & vbNewLine & Cells(p, 3)

h = Split(CDec(Cells(p, 2)) * 100, ".", , vbTextCompare)
End If
Next p

For t = 0 To UBound(h)
If IsNumeric(h(t)) Then
If per = "" Then per = h(t) Else per = per & h(t)
End If
Next

Open folder & "TXT_" & c & per & " " & c & ".txt" For Output As #1
Print #1, id;
Close #1
id = "": per = "": b = ""
Next i
End If
Next dd
End Sub

Hi yinkajewole,
When i try to run the query, after selecting the target folder, I see a run time error: type mismatch, at the line

 c = Cells(dd, 1)

Please help.

 

[yinkajewole]

sorry, replace the first two lines with this

Dim s$, c as variant, j, id$, dd, d() As String, sel As Boolean, folder$, fol As FileDialog, z, b$, i&, p&
Dim h() As String, t&, per$

 

[Rakesh99932]

now am getting same type mismatch error.

h = Split(CDec(Cells(p, 2)) * 100, ".", , vbTextCompare)

SORRY for troubling you.

 

[yinkajewole]

now am getting same type mismatch error.

h = Split(CDec(Cells(p, 2)) * 100, ".", , vbTextCompare)

SORRY for troubling you.

change this

Dim h() As String

to this

Dim h as variant

 

[Rakesh99932]

change this

Dim h() As String

to this

Dim h as variant

Still same error.

 

[yinkajewole]

you mean this same line?

h = Split(CDec(Cells(p, 2)) * 100, ".", , vbTextCompare)

 

[Rakesh99932]

you mean this same line?

h = Split(CDec(Cells(p, 2)) * 100, ".", , vbTextCompare)

yeah