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

thardin

Board Regular
Joined
Sep 29, 2021
Messages
129
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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

1638300817883.png
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,839
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
SendKeys should be avoided normally.

Try replacing:

VBA Code:
    '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:

VBA Code:
    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.
 
Solution

thardin

Board Regular
Joined
Sep 29, 2021
Messages
129
Office Version
  1. 365
Platform
  1. Windows
SendKeys should be avoided normally.

Try replacing:

VBA Code:
    '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:

VBA Code:
    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

Well-known Member
Joined
Nov 7, 2011
Messages
2,839
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
I forgot the last two lines:

VBA Code:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 

thardin

Board Regular
Joined
Sep 29, 2021
Messages
129
Office Version
  1. 365
Platform
  1. Windows
I forgot the last two lines:

VBA Code:
    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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,407
Messages
5,831,436
Members
430,070
Latest member
Renske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top