Help Finishing this VBA Code

[mrbcodc87]

I Have two parts of code i need to put together and add too i need help with making at all work.

The first part of code selects cells D10 across to K10, copies it to another sheet i am using as a database in the last line of the sheet, then clears the original data i have copied from the sheet

Sub SaveLineData()
'
' SaveLineData Macro
'

'
Range("D10:K10").Select
Selection.Copy
Sheets("Database").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCADA Entry Form").Select
Range("F10:K10").Select
Selection.ClearContents
End Sub

the second part of code needs to copy the data from cells D10 across to K10 to a text file along with the username of the use logged in running, then save the text file as the data from cell e10 to my network drive.

Sub Foo()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim fName As String
Dim TextFile As Integer
Dim FilePath As String

Set wbSource = ActiveWorkbook
Set wsSource = ActiveSheet

wsSource.Range("d10:k10").Copy

Shell "notepad.exe", vbNormalFocus

SendKeys "^V"
SendKeys "^{HOME}"


End Sub

I have got the code to open notepad and paste the cells but i am struggling to get it to write the user name, save as (data from e10) then close

if someone could combine these codes and help me finish what i am trying to do that would be great

thanks

 

[Darren Bartrup]

Try something like this:

Sub Test()
    Dim rng As Range
    Dim outputstring As String
    Dim rCell As Range
    Dim lFile As Long
    
    Set rng = ThisWorkbook.Worksheets("SCADA Entry Form").Range("D10:K10")
        
    'Copy data values to Database sheet.
    With ThisWorkbook.Worksheets("Database")
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, rng.Columns.Count) = rng.Value
    End With
    
    'Convert the values in the cells to a single text string.
    For Each rCell In rng
        outputstring = outputstring & rCell.Value & " - "
    Next rCell
    
    rng.ClearContents
    
    'Output data to text file in same folder as Excel file.
    'Date, time, user name and data is appended to text file.
    lFile = FreeFile
    Open ThisWorkbook.Path & "\Data Log.txt" For Append As #lFile
    Print #lFile, Now() & " " & Environ("username") & " - " & outputstring
    Close #lFile
End Sub

 

[mrbcodc87]

Try something like this:

Sub Test()
    Dim rng As Range
    Dim outputstring As String
    Dim rCell As Range
    Dim lFile As Long
   
    Set rng = ThisWorkbook.Worksheets("SCADA Entry Form").Range("D10:K10")
       
    'Copy data values to Database sheet.
    With ThisWorkbook.Worksheets("Database")
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, rng.Columns.Count) = rng.Value
    End With
   
    'Convert the values in the cells to a single text string.
    For Each rCell In rng
        outputstring = outputstring & rCell.Value & " - "
    Next rCell
   
    rng.ClearContents
   
    'Output data to text file in same folder as Excel file.
    'Date, time, user name and data is appended to text file.
    lFile = FreeFile
    Open ThisWorkbook.Path & "\Data Log.txt" For Append As #lFile
    Print #lFile, Now() & " " & Environ("username") & " - " & outputstring
    Close #lFile
End Sub

Thanks that works great!
How can i change the path to where the .txt file is saved?
I want it to be in a folder I have created ("O:\Scada Logs")

 

[Darren Bartrup]

Just change

ThisWorkbook.Path & "\Data Log.txt"

to the path you want. E.g

"C:\Somefolder\Filename.txt

.

 

[mrbcodc87]

Thanks for your help!
I have the final bit of vba code I need for the spreadsheet I need help with if you could help me with if didn’t mind?

Database edit Log

I have a database spreadsheet that gets added to via another sheet in the workbook. once the data has been added to the database it may need editing but i need a log of who edited it and why I need a code the does the following. if any cell in each row is edited in the database it adds a 'yes'...

www.mrexcel.com