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]

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

Edit. Its giving me runtime error 55

 

[Logit]

One thing observed here :

MyRow = 1

    MyCol = 2  '<--- missing
 
    While DoRead
        If Cells(MyRow, [B][COLOR=rgb(226, 80, 65)]MyCol[/COLOR][/B]) <> vbNullString Then
            If Cells(MyRow, 1).Interior.ColorIndex <> 0 Then

 

[Logit]

.
Is this the phrase your macro is looking for ? : QTY. 1 EACH SIZE: .75 X 1.375

If so, what range are you wanting to copy and write to a text file ?

 

[mserfling]

.
Is this the phrase your macro is looking for ? : QTY. 1 EACH SIZE: .75 X 1.375

If so, what range are you wanting to copy and write to a text file ?

Yea thats what its looking for. And Im trying to make it print everything below that to a txt file.

 

[mserfling]

.
Is this the phrase your macro is looking for ? : QTY. 1 EACH SIZE: .75 X 1.375

If so, what range are you wanting to copy and write to a text file ?

I've got the error to go away. Still not sure what the hell happened. But now its making a new file, except its not printing anything to the file...

 

[Logit]

Option Explicit

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 = LastRow To 1 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"
       End If
    Next i

End Sub

 

[Logit]

Auto save selection :

Option Explicit

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 = LastRow To 1 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"
          SendKeys "%fs", True

       End If
    Next i
    
Application.CutCopyMode = False

End Sub

 

[mserfling]

Wow, this works! Thank you. There is one slight issue that I didn't realize with the phrase it's looking for. It does say that phrase twice. Is there any way to ignore the first time it says it because the one I need is when it says that phrase the second time?

 

[Logit]

This macro searches from the bottom up. So it will "grab" the last entry in your database.

If it searches from the top down, it will "grab" the first entry in your database. So ..... how many possible entries of "QTY. 1 EACH SIZE: .75 X 1.375" are there
in the database ? If there might be more than two, the macro will need to take a completely different approach.