How to remove extra empty text file created using vba excel macro wherein its filename is the cell in a sheet?

Question

I'm just new in using excel vba macro. I am trying to create text file and use the cell values as name of individual text file. At the first place the value contains character and those character will be replaced. the only value will remain are all numbers. That function is working well. My problem is once I execute the create button, the program will create an extra text file which name is base on empty cell and no any input "D" as input in the text file. What I want is to create a text file without that extra text file created. below is my excel format and the code.

I have 3 column use as below:

LOG DATA    INPUT   BLOCK NAME
5687    D   ASD
5689    D   
5690    D   
5692    D   
5691    D   
5688    D   
4635    D

Correct result will create four text file:

abc-5687.req
abc-5689.req
abc-5690.req
abc-5692.req

Result with extra text file consider as wrong see below:

abc-.req   <-- extra text file created
abc-5687.req
abc-5689.req
abc-5690.req
abc-5692.req

my code:

Private Sub CREATE_REQ_Click()
    Dim myDataSheet As Worksheet
    Dim myReplaceSheet As Worksheet
    Dim myLastRow As Long
    Dim myRow As Long
    Dim myFind As String
    Dim myReplace1 As String
    Dim myReplace2 As String
    Dim sExportFolder, sFN
    Dim rArticleName As Range
    Dim rDisclaimer As Range
    Dim oSh As Worksheet
    Dim oFS As Object
    Dim oTxt As Object

'   Specify name of Data sheet
    Set myDataSheet = Sheets("Sheet1")

'   Specify name of Sheet with list of replacements
    Set myReplaceSheet = Sheets("Sheet2")

'   Assuming list of replacement start in column A on row 2, find last entry in list
    myLastRow = myReplaceSheet.Cells(Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

'   Loop through all list of replacments
    For myRow = 2 To myLastRow
'       Get find and replace values (from columns A and B)
        myFind = myReplaceSheet.Cells(myRow, "A")
        myReplace1 = myReplaceSheet.Cells(myRow, "B")
'       Start at top of data sheet and do replacements
        myDataSheet.Activate
        Range("A2").Select
'       Ignore errors that result from finding no matches
        On Error Resume Next
'       Do all replacements on column A of data sheet
        Columns("A:A").Replace What:=myFind, Replacement:=myReplace1, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next myRow

    sExportFolder = "D:\TEST\REQ_FILES_CREATED_HERE"
    Set oSh = Sheet1
    Set oFS = CreateObject("Scripting.Filesystemobject")

    For Each rArticleName In oSh.UsedRange.Columns("A").Cells
        Set rDisclaimer = rArticleName.Offset(, 1)
        If rArticleName = "" & "LOG DATA" Then
           oTxt = False
        Else
           'Add .txt to the article name as a file name
           sFN = "-" & rArticleName.Value & ".req"
           Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & ActiveSheet.Cells(2, 3) & sFN, 2, True)

           oTxt.Write rDisclaimer.Value
           oTxt.Close
        End If
    Next

    'Reset error checking
    On Error GoTo 0
    Application.ScreenUpdating = True

    MsgBox "Replacements complete! "
End Sub

Answer 1

For Each rArticleName In oSh.UsedRange.Columns("A").Cells
    Set rDisclaimer = rArticleName.Offset(, 1)
    If Not(rArticleName = "" Or rArticleName = "LOG DATA") Then
        'Add .txt to the article name as a file name
        sFN = "-" & rArticleName.Value & ".req"
        Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & ActiveSheet.Cells(2, 3) & sFN, 2, True)
        oTxt.Write rDisclaimer.Value
        oTxt.Close
    End If
Next

Pretty close to a one line fix. You just need to fix the If. Once that's right you don't need the Else.