Exporting to Notepad

[mserfling]

Hello! I've been trying to make a VBA program that automatically exports a certain portion of an excel file. This will be for multiple files that very but theres always same marker for the portion I need extracted. I am not sure why this isnt working right now. Any suggestions would be appreciated. Heres the code.

Sub ExportToTXT()

    Dim SaveFilePath As String
    Dim DoRead As Boolean
    Dim MyRow As Integer
    Dim FoundHead As Boolean
    Dim MyLabel As Boolean
    Dim MyReadLine As String
    Dim MyCol As Integer
    Dim DeadRowCount As Integer
    Dim SaveLocRes As Variant

    SaveLocRes = Application.GetSaveAsFilename(FileFilter:="TXT Files (*.txt), *.txt", Title:="Save Output")

    If SaveLocRes <> False Then
       SaveFilePath = SaveLocRes
    Else
        Return
    End If
   
    Open SaveFilePath For Output As #1

    DoRead = True
    FoundHead = False
    MyLabel = False
    DeadRowCount = 0
    MyRow = 1
    While DoRead
        If Cells(MyRow, MyCol) <> vbNullString Then
            If Cells(MyRow, 1).Interior.ColorIndex <> 0 Then
                If Not FoundHead Then
                    MyLabel = False
                    If Cells(MyRow, 1) = "QTY. 1 EACH SIZE: .75 X 1.375" Then
                        MyLabel = True
                    End If
                End If
                FoundHead = True
            Else
                If MyLabel Then
                    MyReadLine = Cells(MyRow, 1)
                    MyCol = 2
                    While Cells(MyRow, MyCol) <> vbNullString
                        MyReadLine = MyReadLine & vbTab & Cells(MyRow, MyCol)
                        MyCol = MyCol + 1
                    Wend
                    Print #1, MyReadLine
                End If
                FoundHead = False
            End If
            DeadRowCount = 0
        Else
            DeadRowCount = DeadRowCount + 1
            If DeadRowCount >= 5 Then
                DoRead = False
            End If
        End If
        MyRow = MyRow + 1
    Wend

    Close #1
End Sub

 

[mserfling]

There's never more than two "QTY. 1 EACH SIZE: .75 X 1.375". The issue was that its opening two copies of the same note pad. Not sure how to resolve this. This is my first VBA project lol

 

[Logit]

The macro code is not written to open two copies of the same note pad. It only opens one.

Have you edited the macro ?

 

[mserfling]

The macro code is not written to open two copies of the same note pad. It only opens one.

Have you edited the macro ?

I take that back. The two notepads it opens are different. One where it includes the second phrase we don't want and one that includes the one we do want.

 

[Logit]

Still ... the macro code is not written to open two notepads.

Did you edit the macro ?

Did you combine the macro with another macro ?

 

[Fluff]

Still ... the macro code is not written to open two notepads.

It does for me, one for each occurrence of the string.

 

[mserfling]

Still ... the macro code is not written to open two notepads.

Did you edit the macro ?

Did you combine the macro with another macro ?

I did not edit the macro. I think its making two because theres two instances of the same phrase.

 

[Logit]

My apologies. I was using the first macro here ... not the second macro that includes the "auto save" FileDialog.
Let me look at this to get a solution.

 

[Logit]

.
Will this work for your needs ?

Sub SrchCopyRng()
Dim i As Integer
Dim Str As String
Dim LastRow As Variant

LastRow = Cells(Rows.Count, "A").End(xlUp).Row   '<-- change column here

Str = "QTY. 1 EACH SIZE: .75 X 1.375"     '<--- specify term

    For i = 1 To LastRow Step 1
       If Sheet1.Range("A" & i).Value = Str Then
          Sheet1.Range("A" & i).Resize(LastRow, 4).Copy 'Sheet2.Range("A1")
          Shell "notepad.exe", vbNormalFocus
          'Paste the range
          SendKeys "^V"
          Exit Sub
       End If
    Next i

End Sub

 

[mserfling]

.
Will this work for your needs ?

Sub SrchCopyRng()
Dim i As Integer
Dim Str As String
Dim LastRow As Variant

LastRow = Cells(Rows.Count, "A").End(xlUp).Row   '<-- change column here

Str = "QTY. 1 EACH SIZE: .75 X 1.375"     '<--- specify term

    For i = 1 To LastRow Step 1
       If Sheet1.Range("A" & i).Value = Str Then
          Sheet1.Range("A" & i).Resize(LastRow, 4).Copy 'Sheet2.Range("A1")
          Shell "notepad.exe", vbNormalFocus
          'Paste the range
          SendKeys "^V"
          Exit Sub
       End If
    Next i

End Sub

Potentially? Is there anyway for it to not include the string its looking for?

 

[Logit]

Sub SrchCopyRng()
Dim i As Integer
Dim Str As String
Dim LastRow As Variant

LastRow = Cells(Rows.Count, "A").End(xlUp).Row   '<-- change column here

Str = "QTY. 1 EACH SIZE: .75 X 1.375"     '<--- specify term

    For i = 1 To LastRow Step 1
       If Sheet1.Range("A" & i).Value = Str Then
          Sheet1.Range("A" & i + 1).Resize(LastRow, 4).Copy 'Sheet2.Range("A1")
          Shell "notepad.exe", vbNormalFocus
          'Paste the range
          SendKeys "^V"
          Exit Sub
       End If
    Next i

End Sub