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.

 

[yinkajewole]

check this out.
Assuming the Code % and Transaction ID are in Column A, B, and C respectively

Sub SubsetTest()
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$
s = InputBox("Please, enter the code")
If s <> "" Then c = s Else Exit Sub
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 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 & ".txt" For Output As #1
Print #1, id;
Close #1
id = "": per = ""
Next i
End Sub

 

[Rakesh99932]

check this out.
Assuming the Code % and Transaction ID are in Column A, B, and C respectively

Sub SubsetTest()
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$
s = InputBox("Please, enter the code")
If s <> "" Then c = s Else Exit Sub
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 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 & ".txt" For Output As #1
Print #1, id;
Close #1
id = "": per = ""
Next i
End Sub

Hi yinkajewole,
Tnx a lot for your help. This is working good. But only thing is, if i use lot of data, then i am getting a run time error 6 "overflow". Please help.

 

[yinkajewole]

replace the first two lines with these and see if it works

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$

 

[Sunjinsak]

As a rule, you should never use type hints to declare your variables. They're only included in VBA for backward-compatibility and their use is strongly discouraged by most - including by Microsoft themselves!

Instead you should use the As clause to declare your variables. Taking the above declarations as example...

Dim s As String
Dim c As Long
Dim j As Variant '<---- As this didn't have a type-hint assigned to it it will have been Dimmed as a Variant I believe. It should probably be of type Long or Integer though.
Dim id As String
Dim dd As Variant
Dim d() As String
Dim sel As Boolean
Dim folder As String
Dim fol As FileDialog
Dim z As Variant '<---- Again, should probably be of type Long in this case to prevent possible overflow errors but wasn't explicitly declared as such so I've left it as a Variant here
Dim b As String
Dim i As Long
Dim p As Long
Dim h() As String
Dim t As Long
Dim per As String

You can of course multi-line them as in the below example, but just don't use type hints!

Dim s As String, c As Long, j As Variant 'etc.

It is also generally recommended to give your variables meaningful and descriptive names. It aids code readability a lot and, if done correctly, can often lead to 'self-documenting' code (i.e. code that doesn't need as many explanatory comments telling you what it's doing).

 

[yinkajewole]

As a rule, you should never use type hints to declare your variables. They're only included in VBA for backward-compatibility and their use is strongly discouraged by most - including by Microsoft themselves!

Instead you should use the As clause to declare your variables. Taking the above declarations as example...

Dim s As String
Dim c As Long
Dim j As Variant '<---- As this didn't have a type-hint assigned to it it will have been Dimmed as a Variant I believe. It should probably be of type Long or Integer though.
Dim id As String
Dim dd As Variant
Dim d() As String
Dim sel As Boolean
Dim folder As String
Dim fol As FileDialog
Dim z As Variant '<---- Again, should probably be of type Long in this case to prevent possible overflow errors but wasn't explicitly declared as such so I've left it as a Variant here
Dim b As String
Dim i As Long
Dim p As Long
Dim h() As String
Dim t As Long
Dim per As String

You can of course multi-line them as in the below example, but just don't use type hints!

Dim s As String, c As Long, j As Variant 'etc.

It is also generally recommended to give your variables meaningful and descriptive names. It aids code readability a lot and, if done correctly, can often lead to 'self-documenting' code (i.e. code that doesn't need as many explanatory comments telling you what it's doing).

you are right, i did it out of laziness.
Thanks for that.

 

[Rakesh99932]

replace the first two lines with these and see if it works

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$

Wow, this worked well !!!. Thank you so much for prompt help. It will save lots of my time.

 

[Rakesh99932]

Wow, this worked well !!!. Thank you so much for prompt help. It will save lots of my time.

Please let me know if there is an option that the VBA will automatically take all Codes, instead of manually entering each.
This is just out of curiosity. But your first solution works like charm.

 

[yinkajewole]

You mean all the codes without exception?

 

[yinkajewole]

this should take all the codes

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$
dd = 1
Set fol = Application.FileDialog(msoFileDialogFolderPicker)
fol.AllowMultiSelect = False
sel = fol.Show
If sel Then folder = fol.SelectedItems(1) & "\" Else Exit Sub
Do Until Cells(dd, 1) = ""
c = Cells(dd, 1)
j = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
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 & ".txt" For Output As #1
Print #1, id;
Close #1
id = "": per = ""
Next i
dd = dd + 1
Loop
End Sub