VBA for Excel to copy Columns into Notepad-CodePudding

I have following script

`    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 scripts copies everything on one line

Now the 2 columns G and H should be copied to 2 rows One for G and below for H.

Notepad should open and the content be copied.

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

Regards

Script works apart the 2 rows

CodePudding user response：

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"

CodePudding user response：

Thank you very much for your answer.

Your function how would you insert it into the vba script.

The problem is that this will work globally and we need to be sure that the path and filename can be choosen. So if this is done automatically it can be the folder of the path does not exist.

Regards

Juan