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]

New row where ??
How is it made ??
What code creates the new row ?

Are you panicking ?? ...stop it !!!...

The new row is made at the bottom of the table, NPSS_quote. It is made using the button that runs some VBA.

It is made using the following code

Private Sub cmdAddRow_Click()
ActiveSheet.Unprotect Password:="npssadmin"

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("npss_quote")
'add a row at the end of the table
tbl.ListRows.Add
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True

'ActiveWorkbook.Worksheets("NPSS_quote_sheet").Range

'ActiveSheet.Protect Password:="npssadmin"

End Sub

When the button is pressed, I want the cell in column A of the new row to be activated.


I also have two buttons to make 5 or 10 new rows at once. When these buttons are pressed, I want the cell in column A of the first row in the series of both buttons to be activated.

The code I have for the button to add 5 rows is

Private Sub cmdAdd5lines_Click()

Application.EnableEvents = False
ActiveSheet.Unprotect Password:="npssadmin"

    Dim ws As Worksheet, x As Long
    Set ws = ActiveSheet
    Dim tbl As ListObject
    Set tbl = ws.ListObjects("npss_quote")

    'add 5 rows
    For x = 1 To 5
        'add a row at the end of the table
        tbl.ListRows.Add
    Next x

'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
End Sub

The code I have for the button to add 10 rows is

Private Sub cmdAdd10lines_Click()

Application.EnableEvents = False
ActiveSheet.Unprotect Password:="npssadmin"

    Dim ws As Worksheet, x As Long
    Set ws = ActiveSheet
    Dim tbl As ListObject
    Set tbl = ws.ListObjects("npss_quote")

    'add 5 rows
    For x = 1 To 10
        'add a row at the end of the table
        tbl.ListRows.Add
    Next x

'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
End Sub

Could you help me with this code please?

Thanks Michael,
Dave

 

[Michael M]

This will answer the first question....I'm sure you will be able to modify the other codes.
If not, post back !!

 Private Sub cmdAddRow_Click()
    ActiveSheet.Unprotect Password:="npssadmin"
    Application.EnableEvents = False
    'ActiveSheet.Protect Password:="npssadmin"
    Dim ws As Worksheet, tbl As ListObject
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("npss_quote")
    'add a row at the end of the table
    tbl.ListRows.Add
        ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
    [color=red]tbl.Range.Cells(tbl.ListRows.Count + 1, 1).Select[/color]
    'ActiveSheet.Protect Password:="npssadmin"
    Application.EnableEvents = True
    End Sub

 

[dpaton05]

Thanks Michael, that worked to add a single row.

 

[Michael M]

You could use a single macro for any amount of rows.....that would also get rid of duplicated code throughout the workbook !!
The code simply asks the user how many rows they want to insert !!
I also noted that there were a number of macros duplicated in different sheet modules. I'd get rid of the duplicates as they may start causing issues !

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
    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
        ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = 1
    Next x
'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
End Sub

 

[dpaton05]

I am now getting the error of Select method of range class failed, and it is highlighting Rows("3:1000").Select in:

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
        
        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)
                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
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                        'tblrow.Range.Offset(, 14).Resize(, 3).copy
                        '.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                        'tblrow.Range.Offset(, 29).Resize(, 3).copy
                        '.Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Sort rows based on date
                     [U]  [B][I] Rows("3:1000").Select[/I][/B][/U]
                        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
        Next tblrow
        
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        End Sub

Thanks Michael,
Dave

 

[dpaton05]

So just replace my add 5 and 10 lines bits of code with the one you suggested?

How can I be sure that I am deleting unused bits of code as I am not sure what is used and what is not?

 

[Michael M]

Put a period before the rows

[color=red][b].[/b][/color]Rows("3:1000").Select

So just replace my add 5 and 10 lines bits of code with the one you suggested?

yes, and you can then comment out / remove the excess code AND the buttons, but make sure your button refers to the new code !!
AND
comment out some of the macros and run your codes.....they will error if they aren't available !!

 

[dpaton05]

with post 45, I copied some code from a version that was previously working now it works.

 

[dpaton05]

You could use a single macro for any amount of rows.....that would also get rid of duplicated code throughout the workbook !!
The code simply asks the user how many rows they want to insert !!
I also noted that there were a number of macros duplicated in different sheet modules. I'd get rid of the duplicates as they may start causing <g class="gr_ gr_18 gr-alert gr_gramm gr_inline_cards gr_run_anim Style multiReplace" id="18" data-gr-id="18">issues !</g>

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
    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
        ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = 1
    Next x
'ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
End Sub

How do I get the top cell in column A of the new rows to activate on using the above code as with <g class="gr_ gr_22 gr-alert gr_gramm gr_inline_cards gr_run_anim Punctuation multiReplace" id="22" data-gr-id="22"><g class="gr_ gr_21 gr-alert gr_spell gr_inline_cards gr_disable_anim_appear ContextualSpelling" id="21" data-gr-id="21">tbl</g>.</g>Range.Cells(tbl.ListRows.Count + 1, 1).Select, it is hard coded in?

 

[dpaton05]

In addition to the above question, getting the first, top cell in the group of added rows to activate, how do I change the code to exit the sub if cancel is pressed as at the moment, it gives me an error?

Thanks Michael,
Dave