Save data to Excel from Visual Basic

[wassup]

This is quite a bit different than you first request, try lay out everything that's needed the first time you post and your issue can be resolved a little faster usually.

I'm pretty sure this is what you want.

Private Sub Command1_Click()
    'Requires reference: Microsoft Excel (version) Object Library
    Dim XLapp As New Excel.Application
    XLapp.Visible = True
    Dim wbkReport As Excel.Workbook
    Dim wbkTemplate As Excel.Workbook
    Dim wksReport As Excel.Worksheet
    Dim wksTemplate As Excel.Worksheet
    
    Dim sOpenFileName As String, sSaveAsFileName As String, iSheet As Integer
    
    'Set path to template file here
    sOpenFileName = App.Path & "\" & "My Report Template.xls"
    
    'Set your path to save file here:
    sSaveAsFileName = App.Path & "\" & "Manual Visual Report - " & Replace(Date, "/", "-") & ".xls"
        
    'Open template
    Set wbkTemplate = XLapp.Workbooks.Open(sOpenFileName)
    
    'Suppress Excel warnings
    XLapp.DisplayAlerts = False
    
    If Dir(sSaveAsFileName) <> "" Then
        'if a report from today exists, reset use it as the template
        Set wbkReport = XLapp.Workbooks.Open(sSaveAsFileName)
        Set wksTemplate = wbkTemplate.Sheets(1)
        wksTemplate.Copy after:=wbkReport.Sheets(wbkReport.Sheets.Count)
        Set wksReport = wbkReport.Sheets(wbkReport.Sheets.Count)
        wbkTemplate.Close SaveChanges:=False
    Else
        'This is the first report of the day
        Set wbkReport = wbkTemplate
        'Set reference to first sheet in workbook
        Set wksReport = wbkReport.Sheets(1)
        'Delete extra sheets from template
        If wbkReport.Sheets.Count > 1 Then
            'Start deleting extra sheets (only in this 'copy' of the template) 
            'if they exist, starting from last sheet
            For iSheet = wbkReport.Sheets.Count To 2 Step -1
                If wbkReport.Sheets(iSheet).Name = "Sheet" & iSheet Then wbkReport.Sheets(iSheet).Delete
            Next 'iSheet
        End If
    End If
    
    'Set report sheet name based on form name (duplicate names not allowed...)
    wksReport.Name = Mid(Me.Name, 4)
    
    'Copy text fields
    wksReport.range("E4") = txtPro.Text
    wksReport.range("l4") = txtLine.Text
    wksReport.range("t4") = txtProDate.Text
    wksReport.range("ab4") = txtInspec.Text
    
    'Save workbook as whatever is in "sSaveAsFileName" variable
    wbkReport.SaveAs FileName:= _
        sSaveAsFileName, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    
    'Close workbook
    wbkReport.Close SaveChanges:=False
    
    'Allow Excel warnings
    XLapp.DisplayAlerts = True
    
    'Remove references to sheets/workbooks before quitting (was hanging a second on wksreport if Excel was closed already)
    Set wksReport = Nothing
    Set wbkReport = Nothing
    Set wksTemplate = Nothing
    Set wbkTemplate = Nothing
    
    'Close Excel
    XLapp.Quit
    
    'Remove final reference
    Set XLapp = Nothing
End Sub

Cool danp,

You give me a big help. This is what I want. ^_^ Thanks very much. By the way, nice to meet you.

[wassup]

Cool danp,

You give me a big help. This is what I want. ^_^ Thanks very much. By the way, nice to meet you.

[danp129]

Glad I could help :)

[wassup]

    
    'Set report sheet name based on form name (duplicate names not allowed...)
    wksReport.Name = Mid(Me.Name, 4)
         
    End Sub

Hi,
I want to make some improvement on my vb. Lets say I am using FormA1 and have a combobox, so 1st time I will select combobox list "1" then it will save textbox1 data to the Excel ("F12"), after that I will select list "2", FormA1 also, and it will save textbox1 data to Excel ("F22"). So what I want to improve is it can save data to Excel same worksheet for many time. Thanks for the help.

[wassup]

    
    'Set report sheet name based on form name (duplicate names not allowed...)
    wksReport.Name = Mid(Me.Name, 4)
    
    'Copy text fields
    wksReport.range("E4") = txtPro.Text
    wksReport.range("l4") = txtLine.Text
    
    'Save workbook as whatever is in "sSaveAsFileName" variable
    wbkReport.SaveAs FileName:= _
        sSaveAsFileName, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

I want to make some improvement on my vb. Lets say I am using FormA1 and have a combobox, so 1st time I will select combobox list "1" then it will save textbox1 data to the Excel ("E4"), after that I will select list "2", FormA1 also, and it will save textbox1 data to Excel ("E20"). So what I want to improve is it can save data to Excel same worksheet for many time. Thanks for the help.

Here's my improve souce code

 If combobox1.Text = " 1" Then

'Copy text fields Part 1
    wksReport.Range("E4") = textbox1.Text
    
Else

'Copy text fields Part 2
wksReport.Range("E20") = textbox1.Text

but seem that the source code write by danp129 is not allowed same worksheet name so how should I revise it.

    'Set report sheet name based on form name (duplicate names not allowed...)
    wksReport.Name = Mid(Me.Name, 4)

Thanks.

[danp129]

I want to make some improvement on my vb. Lets say I am using FormA1 and have a combobox, so 1st time I will select combobox list "1" then it will save textbox1 data to the Excel ("E4"), after that I will select list "2", FormA1 also, and it will save textbox1 data to Excel ("E20"). So what I want to improve is it can save data to Excel same worksheet for many time. Thanks for the help.

Here's my improve souce code

 If combobox1.Text = " 1" Then

'Copy text fields Part 1
    wksReport.Range("E4") = textbox1.Text
    
Else

'Copy text fields Part 2
wksReport.Range("E20") = textbox1.Text

but seem that the source code write by danp129 is not allowed same worksheet name so how should I revise it.

    'Set report sheet name based on form name (duplicate names not allowed...)
    wksReport.Name = Mid(Me.Name, 4)

Thanks.

Are you getting an error setting the name or are you just worried about the comments I wrote? wksReport name should already be set to the form name. If you are getting an error then add an if statement to only rename the sheet if it's not already called what you want like:

if wksReport.Name <> Mid(Me.Name, 4) then wksReport.Name = Mid(Me.Name, 4)

[wassup]

    'Set report sheet name based on form name (duplicate names not allowed...)
    wksReport.Name = Mid(Me.Name, 4)

Hi danp,
This source code is when I click Save button then it will create new worksheet based on form name and not allow the same worksheet name to be create right. My concern is I might click twice Save button and it still save the sheet name based on form name.

Below is the twice Save button that I will click. 1st time it save based on form name, 2nd time it also save based on form name, the cell to be save is different only.

If combobox1.Text = " 1" Then
 
'Copy text fields Part 1
    wksReport.Range("E4") = textbox1.Text
    
Else
 
'Copy text fields Part 2
wksReport.Range("E20") = textbox1.Text

I need your help, thanks.

[texmex]

Help me :) please..

I read the most of this replays and I found it useful for my program. I need help to modified the code.

When I enter the text the second time I don´t want a text to be entered on the next new for ex. "sheet(2)" and so on.
Ok, I stopped this in code.

I want next code to do this:

1. First time the text is entered in A2 and B2
2. Second time the text is entered i A3 and B3
3.....
4.....

This must be on the same sheet. I need some loop to count the cells on the second,third... ..entry but not on first.

Here is the code once again:

Private Sub Command1_Click()
'Requires reference: Microsoft Excel (version) Object Library
    Dim XLapp As New Excel.Application
    XLapp.Visible = True
    Dim wbkReport As Excel.Workbook
    Dim wbkTemplate As Excel.Workbook
    Dim wksReport As Excel.Worksheet
    Dim wksTemplate As Excel.Worksheet
 
    Dim sOpenFileName As String, sSaveAsFileName As String, iSheet As Integer, irange As Integer, i As Integer
    
 
    'Set path to template file here
    sOpenFileName = App.Path & "\" & "root\Root.xls"
 
    'Set your path to save file here:
    sSaveAsFileName = App.Path & "\" & "Arhiva - " & Replace(Date, "/", "-") & ".xls"
 
    'Open template
    Set wbkTemplate = XLapp.Workbooks.Open(sOpenFileName)
 
    'Suppress Excel warnings
    XLapp.DisplayAlerts = False
 
    If Dir(sSaveAsFileName) <> "" Then
        'if a report from today exists, reset use it as the template
        Set wbkReport = XLapp.Workbooks.Open(sSaveAsFileName)
        Set wksTemplate = wbkTemplate.Sheets(1)
       
        
        'wksTemplate.Copy after:=wbkReport.Sheets(wbkReport.Sheets.Count)
        'Set wksReport = wbkReport.Sheets(wbkReport.Sheets.Count)
       
        
        wbkTemplate.Close SaveChanges:=False
    Else
        'This is the first report of the day
        Set wbkReport = wbkTemplate
        'Set reference to first sheet in workbook
        Set wksReport = wbkReport.Sheets(1)
        'Delete extra sheets from template
        If wbkReport.Sheets.Count > 1 Then
            'Start deleting extra sheets (only in this 'copy' of the template)
            'if they exist, starting from last sheet
            For iSheet = wbkReport.Sheets.Count To 2 Step -1
                If wbkReport.Sheets(iSheet).Name = "Sheet" & iSheet Then wbkReport.Sheets(iSheet).Delete
            Next 'iSheet
        End If
    End If
 
    'Set report sheet name based on form name (duplicate names not allowed...)
    
 
    'Copy text fields
    wksReport.Range("A2") = Text1.Text
    wksReport.Range("B2") = Text2.Text
   
 
    'Save workbook as whatever is in "sSaveAsFileName" variable
    wbkReport.SaveAs FileName:= _
        sSaveAsFileName, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
    'Close workbook
    wbkReport.Close SaveChanges:=False
 
    'Allow Excel warnings
    XLapp.DisplayAlerts = True
 
    'Remove references to sheets/workbooks before quitting (was hanging a second on wksreport if Excel was closed already)
    Set wksReport = Nothing
    Set wbkReport = Nothing
    Set wksTemplate = Nothing
    Set wbkTemplate = Nothing
 
    'Close Excel
    XLapp.Quit
 
    'Remove final reference
    Set XLapp = Nothing

End Sub

[danp129]

Replace "A65536" with the address of the last cell in the column you are using as the first column you put data in. This column should never be blank if data is in others columns on the same row, or the code will break (overwrite old data to the right).

     ' Copy text fields
     'wksReport.Range("A2") = Text1.Text
     'wksReport.Range("B2") = Text2.Text
    Dim FirstCellOfNewRow As Range
    
    ' This is the same as going to A65536, pressing CTRL+Up Arrow, then releasing CTRL and hitting down arrow to select the first cell of a new row.
    Set FirstCellOfNewRow = wksReport.Range("A65536").End(xlUp).Offset(1, 0)
    
    FirstCellOfNewRow.Value = "first column"
    FirstCellOfNewRow.Offset(0, 1).Value = "second"
    FirstCellOfNewRow.Offset(0, 2).Value = "third"
    FirstCellOfNewRow.Offset(0, 3).Value = "fourth"
    FirstCellOfNewRow.Offset(0, 4).Value = "fifth"

[texmex]

Hi! Thank you for your reply. I used your code but only works if the excell file is empty like you said before.

I want this for example:

1. I fill the form today and program loads data in "Archive-(today´s date).xls (eg. A2 and B2)
2. I fill the form another time today, the data is loaded in the same xls file but in the next row. (eg. A3 and B3)
3. I will fill the form tomorrow, data will be load in "Archive- (tommorrow´s date.xls) like the first orginaly code

Conclusion:

If the data is loaded in same xls file multiply times in a day, every new entry must be filled in the next rows regarding previous entry.

Thanks!

[danp129]

The code I posted had to be added to what you posted, although your code did have a problem re-using a file if it existed because you didn't set wksreport to anything.

You will need to fix the sOpenFileName and sSaveAsFileName as I changed those for testing.

Option Explicit
Const UseNewSheetPerSave As Boolean = False
Private Sub Command1_Click()
'Requires reference: Microsoft Excel (version) Object Library
    Dim XLapp As New Excel.Application
    XLapp.Visible = True
    Dim wbkReport As Excel.Workbook
    Dim wbkTemplate As Excel.Workbook
    Dim wksReport As Excel.Worksheet
    Dim wksTemplate As Excel.Worksheet
 
    Dim sOpenFileName As String, sSaveAsFileName As String, iSheet As Integer, irange As Integer, i As Integer
 
 
    'Set path to template file here
    'sOpenFileName = App.Path & "\" & "root\Root.xls"
    sOpenFileName = "C:\bytesdotcom\vbformToExcel\template.xls"
 
    'Set your path to save file here:
    'sSaveAsFileName = App.Path & "\" & "Arhiva - " & Replace(Date, "/", "-") & ".xls"
    sSaveAsFileName = "C:\bytesdotcom\vbformToExcel\daily - " & Replace(Date, "/", "-") & ".xls"
    
    'Open template
    Set wbkTemplate = XLapp.Workbooks.Open(sOpenFileName)
 
    'Suppress Excel warnings
    XLapp.DisplayAlerts = False
 
    If Dir(sSaveAsFileName) <> "" Then
        'if a report from today exists, use it as the template
        Set wbkReport = XLapp.Workbooks.Open(sSaveAsFileName)
        Set wksTemplate = wbkTemplate.Sheets(1)
 
        If UseNewSheetPerSave = True Then
            wksTemplate.Copy after:=wbkReport.Sheets(wbkReport.Sheets.Count)
            Set wksReport = wbkReport.Sheets(wbkReport.Sheets.Count)
        Else
            Set wksReport = wbkReport.Sheets(1)
        End If
 
        wbkTemplate.Close SaveChanges:=False
    Else
        'This is the first report of the day
        Set wbkReport = wbkTemplate
        'Set reference to first sheet in workbook
        Set wksReport = wbkReport.Sheets(1)
        'Delete extra sheets from template
        If wbkReport.Sheets.Count > 1 Then
            'Start deleting extra sheets (only in this 'copy' of the template)
            'if they exist, starting from last sheet
            While wbkReport.Sheets.Count > 1
                wbkReport.Sheets(2).Delete
            Wend
        End If
    End If
 
    'Set report sheet name based on form name (duplicate names not allowed...)
 
 
   
     ' Copy text fields
     'wksReport.Range("A2") = Text1.Text
     'wksReport.Range("B2") = Text2.Text
    Dim FirstCellOfNewRow As Range

    ' This is the same as going to A65536, pressing CTRL+Up Arrow, then releasing CTRL and hitting down arrow to select the first cell of a new row.
    Set FirstCellOfNewRow = wksReport.Range("A65536").End(xlUp).Offset(1, 0)
 
    FirstCellOfNewRow.Value = TextBox1.Text
    FirstCellOfNewRow.Offset(0, 1).Value = TextBox2.Text
    FirstCellOfNewRow.Offset(0, 2).Value = "a third value could go here"
    FirstCellOfNewRow.Offset(0, 3).Value = "a fourth value could go here"
    FirstCellOfNewRow.Offset(0, 4).Value = "a fifth value could go here"

    'Save workbook as whatever is in "sSaveAsFileName" variable
    wbkReport.SaveAs Filename:= _
        sSaveAsFileName, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
    'Close workbook
    wbkReport.Close SaveChanges:=False
 
    'Allow Excel warnings
    XLapp.DisplayAlerts = True
 
    'Remove references to sheets/workbooks before quitting (was hanging a second on wksreport if Excel was closed already)
    Set wksReport = Nothing
    Set wbkReport = Nothing
    Set wksTemplate = Nothing
    Set wbkTemplate = Nothing
 
    'Close Excel
    XLapp.Quit
 
    'Remove final reference
    Set XLapp = Nothing
 

End Sub