Copy columns into Notepad

Question

I have following Excel VBA code to open Notepad and copy Excel columns into Notepad.

    Dim wsSource As Worksheet
    Dim rDataRange As Range
    Dim rCell As Range
    Dim sCellContent As String
    Dim sStringout As String
    Dim lrowData As Long                                        ' XXX Added
  
'   This is worksheet where data is located.
    Set wsSource = ThisWorkbook.Worksheets("Data")
  
'   This is where data to be processed is located.
    lrowData = wsSource.Range("G" & Rows.Count).End(xlUp).Row   ' XXX Added
    Set rDataRange = wsSource.Range("G40:H" & lrowData)         ' XXX Modified
  
'   Iterate through all source data cells.
    For Each rCell In rDataRange.Columns(1).Cells               ' XXX Loop modified
      
'   Add the cell's content to the full output string
    sStringout = sStringout & rCell.Value & " " & rCell.Offset(, 1).Value & ";"
      
    Next rCell
  
'   Remove trailing semi-colon
    sStringout = Left(sStringout, Len(sStringout) - 1)
  
'   Start Notepad with focus
    Shell "C:\windows\system32\notepad.exe", vbNormalFocus
    
'   Put the string into the free notepad.
    SendKeys sStringout

This copies everything on one line.

The columns G and H should be copied to two lines.
One for G and below for H.

It should look like.

column G -> mail;policy;E164;VoiceRoutingPolicy;Language;DialPlan
column H -> [email protected];UpgradeToTeams;111111111;VRP-GEN-BE-Europe_Zone2;en-US;BE

Max · Accepted Answer · 2022-11-15 10:12:02Z

the "easy solution" amending your code is

Sub twolines()
    Dim wsSource As Worksheet
    Dim rDataRange1 As Range
    Dim rDataRange2 As Range
    Dim rCell As Range
    Dim sCellContent As String
    Dim sStringout As String
    Dim lrowData As Long                                        ' XXX Added
  
'   This is worksheet where data is located.
    Set wsSource = ActiveWorkbook.Worksheets("Data")
  
'   This is where data to be processed is located.
    lrowData = wsSource.Range("G" & Rows.Count).End(xlUp).Row   ' XXX Added
    
    
    Set rDataRange1 = wsSource.Range("G40:G" & lrowData)         ' XXX Modified
    Set rDataRange2 = wsSource.Range("H40:H" & lrowData)         ' XXX Modified
  
'   Iterate through all source data cells.
    For Each rCell In rDataRange1.Cells               ' XXX Loop modified
'   Add the cell's content to the full output string
    sStringout = sStringout & rCell.Value & ";"
    Next rCell
  
'   Remove trailing semi-colon
    sStringout = Left(sStringout, Len(sStringout) - 1)
'   NewLine
    sStringout = sStringout & Chr(13) & Chr(10)
  
    For Each rCell In rDataRange2.Cells               ' XXX Loop modified
'   Add the cell's content to the full output string
    sStringout = sStringout & rCell.Value & ";"
    Next rCell
  
  
'   Remove trailing semi-colon
    sStringout = Left(sStringout, Len(sStringout) - 1)
  
'   Start Notepad with focus
    Shell "C:\windows\system32\notepad.exe", vbNormalFocus
    
'   Put the string into the free notepad.
    SendKeys sStringout
End Sub

BUT: some people think "sendkeys" is kind of bad behaviour, as it is hard to control, user can change result by interacting with PC ....

Other possibility would be to write a ready-to-go txt-file with this function:

Function write_textfile(pathandname_file As String, text As String)
On Error GoTo Ende
Dim Datei As String
Dim Fnr As Long

    Datei = Mid(pathandname_file, 1, Len(pathandname_file) - 3) & "txt"
    Fnr = FreeFile
    Open Datei For Output As Fnr
Print #Fnr, text
    Close Fnr
    Exit Function

Ende:
End Function

by replacing "sendkeys" with "write_textfile c:\myfile.txt, stringout"

Collectives™ on Stack Overflow

Copy columns into Notepad

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related