How to create ONE sub function from repetitive sub-functions

Question

I have created a code where I automate text files, outputting column data from an excel macro, in a specific format. I have created 5 different sub methods where they all contain almost the same lines of code. However, there are two lines of code that change for each sub. I would like to create just ONE sub just to simplify the coding for the user. The end goal is to have just one function that can be called and automatically generate the other output files (from sub test1, sub test2, sub test3, sub test4).

Below is one of the sub function code. The rest are the same except for the following lines:

stream.Write "EQUIPMENT_ID_DEF,02,0x1" & "," & Chr(34) & "ic1080_1" & Chr(34)

For the above line what changes is the 0x1 (it increases) and the "ic1080_1" which changes its name to test1, test2, etc...

If destgroup = "ic1080_1" And ssystem = "A429" And sformat = "BNR" Then

For the above line what changes is the "ic1080_1" name for the other sub names (test1, test2, etc...)

Sub ic1080_1(Path, IDnum As Integer, parmgroup As String)

'Declaring variables
Dim equipID As String, destgroup As String, sourceparmname As String, descript As String
Dim lsb As Integer, msb As Integer, signed As String, sformat As String, units As String
Dim scalefact As Variant, numbits As Integer, decim As Integer
Dim ssystem As String
Dim FName As String, stream As TextStream
Dim fso As Scripting.FileSystemObject
Dim vDB

Set fso = New Scripting.FileSystemObject

'Create txt file
Set stream = fso.CreateTextFile(Path)

'Activate Sheet1
Sheet1.Activate

With Sheet1
    vDB = .Range("a1").CurrentRegion 'Get data to array from excel data range
    n = UBound(vDB, 1) 'Size of array (row of 2 dimension array)
End With

'Open text file to write data
stream.Write "EQUIPMENT_ID_DEF,02,0x" & IDnum & "," & Chr(34) & parmgroup & Chr(34)

'Create arrays for each row of data
For i = 2 To n
    destgroup = vDB(i, 15) '15th columm array(destination group)
    ssystem = vDB(i, 7)    '7th columm array(source system)
    sformat = vDB(i, 32)   '32nd columm array(format)
    sourceres = vDB(i, 11) '11th column array(source resolution)

If destgroup = parmgroup And ssystem = "A429" And sformat = "BNR" Then
    sourceparmname = format(Val(Replace(vDB(i, 8), "label ", "")), "0000")
    descript = vDB(i, 3)
    signed = Val(Replace(vDB(i, 33), "Yes", 1))
    msb = vDB(i, 34)
    lsb = vDB(i, 35)
    units = vDB(i, 6)
    numbits = (msb - lsb + 1)          'Calculates the number of bits
    scalefact = sourceres * (2 ^ (numbits))  'Computes the scale factor by: source resolution *(2^(msb-lsb+1))
    decim = 9

'Write data into text file
stream.Write vbCrLf & "; #### LABEL DEFINITION ####" & vbCrLf & _
    "EQ_LABEL_DEF,02," & sourceparmname & vbCrLf & _
    "UDB_LABEL," & Chr(34) & descript & Chr(34) & vbCrLf & _
    "STD_SUB_LABEL," & Chr(34) & descript & Chr(34) & "," & lsb & "," & msb & "," & signed & vbCrLf & _
    "STD_ENCODING," & Chr(34) & sformat & Chr(34) & "," & Chr(34) & units & Chr(34) & "," & scalefact & "," & numbits & "," & decim & vbCrLf & _
    "END_EQ_LABEL_DEF"

End If
'Continue looping until the last row
Next i

stream.Write vbCrLf & "; #### END EQUIPMENT ID DEFINITION ####" & vbCrLf & _
    "END_EQUIPMENT_ID_DEF"

'Close the text file
stream.Close

End Sub

I also created another sub that calls all the subs ("ic1080_1", test1, test2, test3, test4) to output all the text files and saves them into a folder:

Sub txt_files()

Dim fso As Scripting.FileSystemObject, NewFolderPath As String
Dim Path As String

'Retrieve Target Folder Path From User
NewFolderPath = Application.GetSaveAsFilename("")

Set fso = New Scripting.FileSystemObject
If Not fso.FolderExists(NewFolderPath) Then
    fso.CreateFolder NewFolderPath
End If

'Call sub functions to generate text files and store them in NewFolderPath
Call ic1080_1.ic1080_1(NewFolderPath & "\ic1080_1.txt", 3, "ic1080_1")
Call ic1080_1.ic1080_1(NewFolderPath & "\test1.txt", 4, "test1")



End Sub

I don't understand what you mean by For the above line what changes is the "ic1080_1" and "ic1080_2" name for the other sub names (test1, test2, etc...)? — Enigmativity
– Enigmativity, Commented Oct 16, 2017 at 22:32
And Sub "ic1080_1"(Path) isn't valid VBA. What's going on there? — Enigmativity
– Enigmativity, Commented Oct 16, 2017 at 22:33
FWIW Left(destgroup, 7) = "ic1080_1" will always be false, because no seven character string will be equal to the string "ic1080_1" (which has 8 characters( — YowE3K
– YowE3K, Commented Oct 16, 2017 at 22:37
@Enigmativity, Thank you for the edit, I appreciate it. I have other 4 sub methods which contain the same lines of code except the two mentioned above. For example, for test1, those lines would be: stream.Write "EQUIPMENT_ID_DEF,02,0x2" & "," & Chr(34) & "test1" & Chr(34) — Jesus
– Jesus, Commented Oct 16, 2017 at 22:38
If destgroup = "test1" And ssystem = "A429" And sformat = "BNR" Then — Jesus
– Jesus, Commented Oct 16, 2017 at 22:39

YowE3K · Accepted Answer · 2017-10-16 23:57:44Z

2

Pass the bits that change between the subroutines as parameters:

Sub txt_files()
    '...

    'Call sub function to generate text files and store them in NewFolderPath
    GenericSub NewFolderPath, "ic1080_1", "1"
    GenericSub NewFolderPath, "test1", "2"
    GenericSub NewFolderPath, "test2", "3"
    GenericSub NewFolderPath, "test3", "4"
    GenericSub NewFolderPath, "test4", "5"
End Sub

Sub GenericSub(Path As String, something As String, somethingElse As String)
    '...
    Set stream = fso.CreateTextFile(Path & "\" & something & ".txt")
    '...
    stream.Write "EQUIPMENT_ID_DEF,02,0x" & somethingElse & "," & _
                  Chr(34) & something & Chr(34)
    '...    
    If destgroup = something And ssystem = "A429" And sformat = "BNR" Then
        '...
    End If
    '...    
End Sub

I may not have picked up on all the places where you are using the different parameters, but that should give you something to go on.

And please don't use names such as something and somethingElse and even GenericSub - use something meaningful to describe them. I just used those names because I wasn't sure what they meant.

edited Oct 16, 2017 at 23:57

answered Oct 16, 2017 at 22:54

YowE3K

24k7 gold badges28 silver badges45 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Jesus Over a year ago

I have edited my code (please see above). However, when I pass the arguments, it seems like the other sub procedure are not taking those arguments since I keep getting repeated output files (for ic1080_1)...

YowE3K Over a year ago

(a) The edits you made to the code in your question now make the question completely incomprehensible to anyone trying to answer it (i.e. the question is discussing code that isn't shown in the question, and the code in the question doesn't have the issues discussed in the question). (b) I can think of no reason why Set stream = fso.CreateTextFile(Path) can create a file with a filename of "ic1080_1.txt" if path is passed to that subroutine as some path & "\test1.txt". I would suggest you step through your code and look to see what value is being passed.

YowE3K Over a year ago

@Jesus Also, I noticed my answer hadn't included the ".txt" at the end of the filename - I have updated that to correct the issue.

YowE3K Over a year ago

I think you will need to step through your rewritten code (just press F8 to execute line-by-line through txt_files and into the subroutine) and watch what happens to the variables in the Locals Window. If you can't work out what is wrong, rewrite your entire question to reflect what your current problem is - i.e. that the parameters passed from txt_files are not being used by the subroutine. (Normally you should ask a new question but, because I am the only person who has answered the old question, I can just delete my answer and we can pretend the question was always the new one.)

Jesus Over a year ago

I got it to work! :) I was just overwriting the 3 arguments that I was passing in my sub by giving them a value in the sub procedure. I deleted them and it works now! Thank you very much.

Collectives™ on Stack Overflow

How to create ONE sub function from repetitive sub-functions

1 Answer 1

5 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Related