Changing linking so instead of being between tables, it is linking between ranges

[dpaton05]

I have been working on a spreadsheet for months. This spreadsheet involved filling out information in a table, upon finishing, it would be copied to another table on another sheet, where further information would be added. Once this had been done, it would be copied to another workbook. The way I had it set up was a table on the first sheet which would be copied to a table on the second sheet and finally a range in the different work book.

I have been having all kinds of problems and I have had it recommended that I convert it all so it is going from range to range to range. I am not the best at coding, as I am still learning and I wanted some assistance. I am fine with formatting the sheets, just need help with the coding.

The last workbooks are financial year documents and each row in the first sheet will have a date which is transferred to the second sheet with the other relevant information for the row. The rows contain quotes for various services. Each row is transferred one row at a time.

Could someone please help me with the code I would use to transfer each row from one range object to the next?

I have attached a copy of my spreadsheet to give you some idea of what I want.

https://www.dropbox.com/s/fjljdrd0afd0wgs/quoting tool 11.7 WCI.xlsm?dl=0

Thanks,
Dave

 

[dpaton05]

• I have copied the code into module 1.
• I am trying to assign it to the add line button on the quote sheet.
• The button is called cmdAdd_Nlines

 

[Michael M]

Go to the Developer Tab
Right Click on the Add line button>>Properties
On the first line of the properties box, Change the name to cmdAdd_Nlines

 

[dpaton05]

I have already done that.

 

[dpaton05]

I could change the procedures so they are public instead of private procedures. Is there anything wrong with that? Is it not good practise?

 

[dpaton05]

Not really....you could change the thiswoorkbook to activeworkbook
AND
remove the brackets

Workbooks.Open Activeworkbook.Path & "\" & docYearName & ".xlsm"

Continuing on from post 29, the code opens the allocation sheet so there must be something else in the code that prevents it from opening.

 

[dpaton05]

I can't really help you with this one Dave.
It's been an ongoing issue with that particular line causing problems for quite some time, but working fine at home AND on OP's computers !!
The only thing I can suggest, is make a copy of the workbook AND the allocation sheet, put them in the same temporary folder.
THEN.....remove all code from the project except this particular macro and run them and see what happens.

It is almost impossible for us to help, when this problem can't be reproduced on my / our computers.
My other concern is that you have a lot of code in sheet modules, where it SHOULD NOT be !!.....and I wonder if this might be affecting the process

I made a new folder, put a copy of the allocation sheet and quoting tool in it, removed all code except that procedure and it still gave the same error.

 

[Michael M]

You shouldn't have to do that !!
But here is some reading on Private vs Public Subs

https://www.thespreadsheetguru.com/blog/2014/3/5/explaining-private-vs-public-declarations

With regard to

Workbooks.Open Activeworkbook.Path & "" & docYearName & ".xlsm"

If you can open it at home AND a number of forum users can open it on their computers, it HAS to be a problem at your office !!
It can't really be the code can it ??......we already know that the code works on other computers !

 

[dpaton05]

If the allocation sheet is open on my computer, the copy will work so my supervisor wants a message box to pop up if the allocation sheet is not open and ask for the allocation sheet to be opened. How do I add this into my code?

Here is the copy code.

Sub cmdCopy()
        Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
        Dim Combo As String, sht As Worksheet, tbl As ListObject
        Dim lastrow As Long, DocYearName As String, lr As Long
            Application.ScreenUpdating = False
        '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
        Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
            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
                'Workbooks.Open ThisWorkbook.Path & "\" & DocYearName & ".xlsm"
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
             lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
             With wsDst
                    'This copies the first 16 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 16).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:AK" & lr)
                                .header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                    ActiveWorkbook.Save
                   ' ActiveWorkbook.Close
                End With
        Next tblrow
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
End Sub

 

[Michael M]

UNTESTED

Sub cmdCopy()
        Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
        Dim Combo As String, sht As Worksheet, tbl As ListObject
        Dim lastrow As Long, DocYearName As String, lr As Long
            Application.ScreenUpdating = False
        '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
        Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
            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
            [color=red]On Error Resume Next
            Set wb = ThisWorkbook.Path & "\" & DocYearName & ".xlsm"
            If Err Then
            MsgBox "The workbook is not open"
            Workbooks.Open ThisWorkbook.Path & "\" & DocYearName & ".xlsm"
            End If[/color]
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
             lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
             With wsDst
                    'This copies the first 16 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 16).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:AK" & lr)
                                .header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                    ActiveWorkbook.Save
                   ' ActiveWorkbook.Close
                End With
        Next tblrow
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
End Sub

 

[dpaton05]

Do I need to Dim wb as workbook?