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

 

[Michael M]

Try using

Private Sub cmdAdd_Nlines_Click()
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="npssadmin"
    Dim ws As Worksheet, x As Long, tbl As ListObject, n As Long
   On Error GoTo cancelled:
   n = InputBox("How many lines would you like to add ?")
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("npss_quote")
    For x = 1 To n
        'add a row at the end of the table
        tbl.ListRows.Add
    Next x
tbl.Range.Cells(tbl.ListRows.Count - 1, 1).Select
'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
cancelled:
Exit Sub
End Sub

 

[Michael M]

Sorry Dave....typo
Try this one instead

Private Sub cmdAdd_Nlines_Click()
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="npssadmin"
    Dim ws As Worksheet, x As Long, tbl As ListObject, n As Long
   On Error GoTo cancelled:
   n = InputBox("How many lines would you like to add ?")
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("npss_quote")
    'add 5 rows
    For x = 1 To n
        'add a row at the end of the table
        tbl.ListRows.Add
    Next x
tbl.Range.Cells(tbl.ListRows.Count - n + 2, 1).Select
'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
cancelled:
Exit Sub
End Sub

 

[dpaton05]

Thanks for that Michael, I was testing the first one and I was about to post a response with the results only to realise that you had already fixed it

 

[dpaton05]

I found another problem. Remember the extra row that was created. Well, it is only creating the extra row the first time the copy is performed, for instance, if nothing is in Costing_tool. Every other time it does not make an extra row so the code deletes a row of data each time the copy is performed after the first time.

Actually, I think that someone else helped me with that code, here it is:

'''''''deletes last row in tblCosting if it is a blank row
    If desWS.ListObjects.Count > 0 Then
        For Each oLst In desWS.ListObjects
            If oLst.ListRows.Count > 0 Then
              oLst.ListRows(oLst.ListRows.Count).Delete
            End If
        Next oLst
    End If

Could you help me change this code so it only deletes the row if it is blank please?


Thanks Michael,
Dave

 

[dpaton05]

I tried the file at work and it gave me some errors about re-opening the file again would cause some data loss. I commented out

'Workbooks.Open ThisWorkbook.Path & "\" & DocYearName & ".xlsm"

and ran it again. Just as I expected, it told me subscript out of range so I opened the allocation sheet and the procedure worked fine.

I removed the comment to put the line back in that I previously commented out and closed the allocation sheet. When I tried to run it again, I got the error to say it is already open, do you want to re-open it, even though it wasn't. If I press no, I get the Method open of object workbooks failed. I have 4 lines in the costing tool and if I press Yes, the same error box is displayed again, pressing yes again will make it display again for a total of 3 times before it stops appearing. I look at the allocation sheet that is now open and there is only 1 line, where there should be 4. The row in the allocation sheet is the last row from the table in tblCosting.

The code for cmdCopy is

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 10 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
                End With

        Next tblrow
        
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        End Sub

 

[dpaton05]

If I have the allocation sheet closed, I get the error 3 times but if I have the allocation sheet open I get the error 4 times. In both cases, there is still only the last row from tblCosting pasted in to the allocation sheet.

 

[Michael M]

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

 

[Michael M]

Just a thought, but....
1. Is the allocation sheet a shared file, or available to others, so they can use it as well ??
2. Is it possble that someone else has it open when you try to run this code ??
3. Could someone have it sitting open but not using it ??

 

[dpaton05]

Thanks anyway for helping Michael. I will try to clean up the code but that is about all I can think of doing. It is ok but, if I can't get it working, I will just tell my supervisor.

 

[Michael M]

Did you read Post #58