How to copy data from Excel to an existing NotePad txt file, overriding existing data.

[thardin]

This is an advanced macro I created to copy rows from 3 worksheets in 1 WB into 1 column of another WB.
All of it works besides the last step of pasting the data into NotePad. (Picture is provided below)

How do you recommend accomplishing this?
Any other feedback is appreciated. Thanks.

Function WorksheetExists(SheetName As String) As Boolean
    Dim ws As Worksheet
    WorksheetExists = False
    
        For Each ws In Worksheets
            If ws.name = SheetName Then
                WorksheetExists = True
                Exit For
            End If
        Next
End Function

Function GetLastRedRow(ws As Worksheet) As Integer
    
    Dim ws As Worksheet
    Dim Cell As Range
    Dim lr As Long

    
    lr = Cells(Rows.Count, "B").End(xlUp).row
    
    GetLastRedRow = 0
    
    For Each Cell In ws.Range("B4", ws.Range("B" & Rows.Count).End(xlUp))
        If cl.Font.ColorIndex = 3 Then
            GetLastRedRow = GetLastRedRow + 1
        Else
            Exit For
        End If
            
    Next Cell

End Function

Sub Test()
'
    Dim ws1 As String, ws2 As String, ws3 As String
    Dim strFullDate As String, strFullDate2 As String, strFullDate3 As String
    Dim lr As Long
    Dim S As String
    Dim Ary As Variant
    Dim Fname As String, DestinationFileName As String
    Dim SourceFileName As String
    
    strFullDate = Format(Date, "yyyymmdd")
    strFullDate2 = Format(Date, "mm.dd.yy")
    strFullDate3 = Format(Date, "mmddyy")
    SourceFileName = strFullDate & " Restrictions Voids " & MY_INITIALS & " " & strFullDate2 & ".xlsx"
    DestinationFileName = "UBTREJ" & strFullDate3 & ".xlsx"
    
    Workbooks(SourceFileName).Activate
    
    ws1 = UBT_WS1 'These are public constants listed in another Module
    ws2 = UBT_WS2
    ws3 = UBT_WS3

    
    '   Find last row in column B with data
    lr = Cells(Rows.Count, "B").End(xlUp).row
        
    
    If WorksheetExists(ws1) Then
        '   Copy data
        ws1Row_Start = 2
        ws1Row_Count = Worksheets(ws1).Cells(Rows.Count, "B").End(xlUp).row - 3
        With Worksheets(ws1).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
          End With
   'Pastes data in destination file in cell A2 Data:
        Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws1Row_Start).Resize(UBound(Ary), 2).Value = Ary
        
    End If
        
    
    If WorksheetExists(ws2) Then
        '   Copy data
            ws2Row_Start = ws1Row_Start + ws1Row_Count
                
    ws2Row_Count = Worksheets(ws2).Cells(Rows.Count, "B").End(xlUp).row - 3
        With Worksheets(ws2).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
       'Pastes data in destination file under WS1 Data:
       Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws2Row_Start).Resize(UBound(Ary), 2).Value = Ary
    
     End If

    If WorksheetExists(ws3) Then
     '   Copy data
        ws3Row_Count = Worksheets(ws3).Cells(Rows.Count, "B").End(xlUp).row - 3
            ws3Row_Start = ws2Row_Start + ws2Row_Count
        With Worksheets(ws3).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
        'pastes data in destination file under the WS1 and WS2 data:
        Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws3Row_Start).Resize(UBound(Ary), 2).Value = Ary
          
    End If
    
    Workbooks(DestinationFileName).Activate
        lr = Cells(Rows.Count, "A").End(xlUp).row
        Range("A2:A" & lr).Copy
  
    'This step doesn't Work!!--> I'm trying to copy Column A2 and down from the DestinationFile name into Notepad:

    Call Shell("notepad.exe " & MY_DESKTOP & "Notepad.txt", vbNormalFocus)
    Application.SendKeys ("^a")
    Application.SendKeys ("^v")
    Application.SendKeys ("^s")
    


End Sub

 

[johnnyL]

SendKeys should be avoided normally.

Try replacing:

    'This step doesn't Work!!--> I'm trying to copy Column A2 and down from the DestinationFile name into Notepad:

    Call Shell("notepad.exe " & MY_DESKTOP & "Notepad.txt", vbNormalFocus)
    Application.SendKeys ("^a")
    Application.SendKeys ("^v")
    Application.SendKeys ("^s")

with:

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
'
    Workbooks.Add
'
    Range("A1").PasteSpecial Paste:=xlPasteValues
'
    ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop" & "\" & "Notepad.txt", FileFormat:=xlText
    ActiveWorkbook.Close False

That will save the data to a file called 'Notepad.txt" to the desktop.

 

[thardin]

SendKeys should be avoided normally.

Try replacing:

    'This step doesn't Work!!--> I'm trying to copy Column A2 and down from the DestinationFile name into Notepad:

    Call Shell("notepad.exe " & MY_DESKTOP & "Notepad.txt", vbNormalFocus)
    Application.SendKeys ("^a")
    Application.SendKeys ("^v")
    Application.SendKeys ("^s")

with:

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
'
    Workbooks.Add
'
    Range("A1").PasteSpecial Paste:=xlPasteValues
'
    ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop" & "\" & "Notepad.txt", FileFormat:=xlText
    ActiveWorkbook.Close False

That will save the data to a file called 'Notepad.txt" to the desktop.

worked great! Thanks

 

[johnnyL]

I forgot the last two lines:

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

 

[thardin]

I forgot the last two lines:

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

Yeah, I was actually wondering about that when I first saw this, but forgot. Thanks for pointing that out.