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]

OK, so if an earlier version was / is working......what did you change to stop it from working !!
When you are updating / improving, as slow and tedious as it seems, change one thing only, then, test, test, test...when it works change something else...otherwise you will go round in circles trying to resolve issues
AND
make notes of changes !! Then you can look back at what you changed to see if it has been the cause of a current problem.

 

[dpaton05]

In the file I have now, it is copying all the rows from NPSS_quote_sheet to Costing_tool but it is copying one extra blank row. I remember that I had this problem before and I got code from somewhere to delete the extra row. This time however, I wanted to look at the code and try to work out why it is adding an extra row. I had trouble finding it so could you look through the code and see where it is adding the extra blank row please?

Just realised something, it only occurs when it is the first time that anything is copied to the costing_tool. Any time after the first time appears to fill the extra, blank line. Also, if there is only 1 row in NPSS_quote_sheet, it will be copied to Costing_tool as one line, without the blank row.



Here is my code that NPSS_quote_sheet to Costing_tool:

Private Sub CmdSend_Click()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim desWS As Worksheet
    Dim srcWS As Worksheet
    
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet")
    Set desWS = ThisWorkbook.Sheets("Costing_tool")
    
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim x As Long
    Dim header As Range
    
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
    lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With srcWS.Range("A:A,B:B,H:H")
        If lastRow2 < 5 Then
            lastRow2 = 5
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                    desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next i
            With desWS
                If .Range("A" & .Rows.Count).End(xlUp).Row > 5 Then
                    desWS.ListObjects.Item("tblCosting").ListRows.Add
                End If
                .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B6")
            End With
        Else
            lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            desWS.ListObjects.Item("tblCosting").ListRows.Add
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                    desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next i
            With desWS
                .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
            End With
        End If
    End With
    
    desWS.ListObjects("tblCosting").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting").Sort.SortFields. _
        Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("tblCosting").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Application
        .CutCopyMode = False
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Thanks Michael,
Dave

 

[dpaton05]

I am sorry I have not been keeping notes as I have been going along. I will do it now and thanks for the advice to do it.

 

[Michael M]

If you think back, the problem was caused by the costing tool Table being copied to, always had to have at least 1 row.
So, when we pasted the lines across it appeared to have 1 extra row !!

 

[dpaton05]

Thanks for reminding me.

 

[dpaton05]

Should I incorporate the Application.GetOpenFilename feature into my open code?

 

[Michael M]

Why ??
Won't that leave it open for the user to select the wrong file ???

 

[dpaton05]

I want to set the focus on the first cell in the row when a new row is made, how do I do this?

 

[dpaton05]

Why ??
Won't that leave it open for the user to select the wrong file ???

I don't know. I just read it had something to do with opening files and I thought it might of been useful in my case.

 

[Michael M]

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

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