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

I thought it was working but now it isn't. Now it says The sort reference is not valid. Make sure that it's within the data you want to sort, and the first sort by box is not the same or blank.

 

[Michael M]

Re: help with opening and closing workbooks using vba

There is NO Sort code in the macro you posted !!!
You really need to explain where this sort code is !

 

[dpaton05]

Re: help with opening and closing workbooks using vba

There is NO Sort code in the macro you posted !!!
You really need to explain where this sort code is !

Not sure why there wasn't any sort code but here is the code I am using.

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])"
                    'Select rows to sort
                    .Rows("3:1000").Select
                    'sort procedure copied from vba
                    Workbooks(DocYearName).Worksheets(Combo).sort.SortFields.Clear
                    Workbooks(DocYearName).Worksheets(Combo).sort.SortFields.Add Key:=Range("A4:A1000"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Workbooks(DocYearName).Worksheets(Combo).sort
                                .SetRange Range("A3:AJ1000")
                                .header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                End With
            'save and close the workbook
            ActiveWorkbook.Save
            ActiveWorkbook.Close


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

Is there any way Michael to change the code around somehow to make it a little faster?


Thanks Michael,
Dave

 

[dpaton05]

Re: help with opening and closing workbooks using vba

Also, the sorting is not working.

 

[Michael M]

Re: help with opening and closing workbooks using vba

Ah, finally....you have posted ALL of the code.
Do you really need to sort 1000 rows ???
Try alos, activating the workbook and sheet you want to sort !

 

[dpaton05]

Re: help with opening and closing workbooks using vba

sorry, accidentally posted that again

 

[dpaton05]

What do I put in it to sort by all the rows in the sheet? I didn't know so I thought that there wouldn't be more than 1000 rows so I just put that to include everything.

 

[Michael M]

UNTESTED

Sub cmdCopy()

    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    End With
        Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
        Dim Combo As String, sht As Worksheet, tbl As ListObject
        Dim LastRow As Long, lr As Long, DocYearName As String
        'assign values to variables
        Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
        For Each tblrow In tbl.ListRows
            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
      '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)
             lr = wsDst.Cells(Rows.Count, "A").End(xlUp).Row
             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])"
                    'sort procedure copied from vba
                    wsDst.Sort.SortFields.Clear
                    wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Workbooks(DocYearName).Worksheets(Combo).Sort
                                .SetRange Range("A3:AJ" & lr)
                                .Header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                End With
            'save and close the workbook
            ActiveWorkbook.Save
            ActiveWorkbook.Close


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

 

[dpaton05]

I mean, how do I put in that xldown feature to sort by the entries that are included to the end of the rows entered?

 

[dpaton05]

sorry, I didn't realise you had already replied.