Opening and closing workbooks using vba

[dpaton05]

I have a tool to calculate quotes which is in a table and can have x number of rows. Once the quote is made, I have a button to copy each row to a costing tool, which is just another sheet. Once this is done, further details can be added to the quote to finalise it. I then select a button to send it to the correct allocation sheet. These sheets are separate financial year documents and are used to keep record of the quotes.

I have code successfully does all the above tasks but it requires the allocation sheets to be open. The quote may have services that are relating to the next 10 years and my supervisor doesn't want to need to have all the allocation sheets open for that time. Therefore, I want to add code into the copy procedure that will open the workbook, copy in the row from the data then close it.

I am still learning to code so I have had to rely a lot on others.

I thought that I could add code in just before and after the copy code is run. The problem is that it is giving me all kinds of strange errors when I do this.

The variable DocYearName refers a column for the row that contains the full file name of where the quote needs to go.
The variable Combo refers to sheet within DocYearName that the quote needs to go on.

        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
                If tblrow.Range.Cells(1, 6).Value = "Ang Wes" Then
                    DocYearName = tblrow.Range.Cells(1, 37).Value
                Else
                    DocYearName = tblrow.Range.Cells(1, 36).Value
                End If


            
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                With wsDst
                    'To open the workbook stored in the variable DocYearName
                    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & DocYearName
                    'This copies the first 10 columns, i.e. A:J, of the  current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 10).Copy
                    'This pastes in the figures in the first 10 columns starting in column A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    'Overwrites the numbers pasted to column I with a formula
                    .Range("I" & .Range("I" &  .Rows.Count).End(xlUp).Row).Formula =  "=IF(R[1]C[-4]=""*Activities"",0,RC[-1]*0.1)"
                    'Overwrites the numbers pasted to column J with a formula
                    .Range("J" & .Range("J" &  .Rows.Count).End(xlUp).Row).Formula =  "=IF(R[1]C[-5]=""*Activities"",RC[-2],RC[-1]+RC[-2])"
                    ActiveWorkbook.Close

                                    
                End With
        Next tblrow

So it all works except when I added in the open and close lines at the start and end of the last chunk of code. The files will be all stored in the same directory.

Could someone help me please?

 

[dpaton05]

Re: help with opening and closing workbooks using vba

Just partially worked it out. I moved the open and closing lines of code outside of the first With loop.

My code now looks like this:

            'To open the workbook stored in the variable DocYearName
           [I] Workbooks.Open Filename:=ThisWorkbook.Path & "\" & DocYearName[/I]
            
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 10).Copy
                    'This pastes in the figures in the first 10 columns starting in column A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    'Overwrites the numbers pasted to column I with a formula
                    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-4]=""*Activities"",0,RC[-1]*0.1)"
                    'Overwrites the numbers pasted to column J with a formula
                    .Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-5]=""*Activities"",RC[-2],RC[-1]+RC[-2])"
                End With
[I]            ActiveWorkbook.Save
            ActiveWorkbook.Close[/I]

Now the problem is that it takes so long to copy the data, where it used to be a very quick procedure. Could someone please show me how I should structure it so that it is as quick as it used to be?

 

[James006]

Re: help with opening and closing workbooks using vba

Hello,

At the top of your code

Application.Calculation = xlCalculationManual

and at the very end

Application.Calculation = xlCalculationAutomatic


Hope this will help

 

[dpaton05]

Re: help with opening and closing workbooks using vba

Thanks for replying James. I put that code in and it still thinks for about 5 seconds once you run the code whereas before, it would think for maybe 1 second max after running the code. Any other ideas?

 

[James006]

Re: help with opening and closing workbooks using vba

Hello,

At the top of your code

Application.ScreenUpdating = False

and at the very end

Application.ScreenUpdating = True


Hope this will help

 

[Michael M]

Re: help with opening and closing workbooks using vba

So combine both
at the start

with application
   .Calculation = xlCalculationManual
   .ScreenUpdating = False
end with

at the end

with application
   .Calculation = xlCalculationautomatic
   .ScreenUpdating = true
end with

Also make sure the files and the quote tool are in the same folder

 

[dpaton05]

Re: help with opening and closing workbooks using vba

I did that but it still thinks for maybe 5 or 6 seconds. Here is the code, thanks.

Sub cmdCopy()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
        Dim wsDst As Worksheet
        Dim wsSrc As Worksheet
        Dim tblrow As ListRow
        Dim Combo As String
        Dim sht As Worksheet
        Dim tbl As ListObject
        Dim LastRow As Long
        Dim DocYearName As String
        
        
        'assign values to variables
        Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
        For Each tblrow In tbl.ListRows
            'If columns are blank, display alert
            If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
                MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
                Exit Sub
            End If
        Next tblrow
        
        For Each tblrow In tbl.ListRows
            'For every row, set value of combo to the name of the month that contains the date of the row
            Combo = tblrow.Range.Cells(1, 26).Value
                
            If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                DocYearName = tblrow.Range.Cells(1, 37).Value
            Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End If
                       
            'To open the workbook stored in the variable DocYearName
            Workbooks.Open Filename:=ThisWorkbook.Path & "\" & DocYearName
            
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 10).Copy
                    'This pastes in the figures in the first 10 columns starting in column A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    'Overwrites the numbers pasted to column I with a formula
                    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[0]C[-4]=""*Activities"",0,RC[-1]*0.1)"
                    'Overwrites the numbers pasted to column J with a formula
                    .Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-5]=""*Activities"",RC[-2],RC[-1]+RC[-2])"
                End With
            ActiveWorkbook.Save
            ActiveWorkbook.Close

        Next tblrow
   
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End With
End Sub

 

[Michael M]

Re: help with opening and closing workbooks using vba

How long did the entire code take to run previously ??
How long does it take now ??
How long would it take to do all of this processing, if you had to do it manually ??
Remember, it has to find / open / preocess / save / close the other workbook !!

 

[dpaton05]

Re: help with opening and closing workbooks using vba

It used to take about 1 second and now it takes about 6 seconds. I guess it is a good trade off for what it does. I am having trouble now Michael with trying to sort the destination sheet where the data is put but I think it could be sped up if a save and sort on sheets that had data transferred to them occured at the end of the copy process. So just one sort and save instead every time a row is copied to a sheet.

Could you please help me with code that will sort and save the sheets that have had data copied into them in date order, once the copy has fully occured. The latest version of my code is in post 7 and the date is stored in column A. In the destination sheet, there is a header row in row3, with the range that needs sorting starting in row 4. This can have x number of rows and needs sorting by date in ascending order.

Thanks Michael,
Dave

 

[Michael M]

Re: help with opening and closing workbooks using vba

The code in Post #7 doesn't sort any data ???