Transferring between workbooks

[dpaton05]

I have a complex spreadsheet that is used to generate a quote. The quote has information at the top: Caseworker, Organisation and Child/YP in 3 different cells. There is then a table under that called npss_quote. The table has rows relating to the information at the top.

The quotes then need to be copied to a another spreadsheet. This spreadsheet is called Costing tool. In Costing tool there is a table called tblCosting which contains more details regarding the quotes. The rows from npss_quote need to be copied below rows that exist in tblCosting. The information at the top of the quoting spreadsheet, Caseworker, Organisation and Child/YP needs to be the same for every row that gets copied across but the rows in npss_quote will have information that is specific to the individual row. The specific information for each row is Date, Service and Price.

I need code to be run from within the quoting spreadsheet to transfer the rows across to costing tool. I could work a lot of it out myself but I am not sure about copying the 3 cells at the top of the quoting spreadsheet to be the same for every row in npss_quote but then to have specific information regarding each row. The information that is specific to each row is Date, Service and Price.

So, every row that is copied from npss_quote to tblCosting will have the 3 cells at top of the quoting spreadsheet: Caseworker, Organisation and Child/YP, the same for each row. Every row in tblCosting will have a Date, Service and Price that is specific to each row in npss_quote.


The 3 cells at the top of the quoting spreadsheet that are to be copied for every row are:

• Caseworker in B6
• Organisation in B7
• Child/YP in in a merged cell G6:H6

These need to be copied for each row that is copied from npss_quote to tblCosting. The cells in tblCosting that they need to go in are:

• Caseworker needs to be put in column G
• Organisation needs to be put in column F
• Child/YP needs to be put in column D

The location of information that is specific to every row, Date, Service and Price is as follows:

• Date is column A of npss_quote and needs to go in column A in tblCosting
• Service is in column B of npss_quote and needs to go in column E in tblCosting
• Price is in column H of npss_quote and needs to go in column H in tblCosting

The header row for npss_quote is in row 10 with data starting in row 11. The header row for tblCosting is in row 4 with the data starting in row 5.


I have tried to explain this but if it doesn't make sense, please reply to me and ask for clarification.




I would just like to say that this forum is the best,
I would really appreciate help with this,

Dave

 

[dpaton05]

With the first point in the previoius post, the date doesn't copy at all.

 

[mumps]

Here are the links to your files:
https://app.box.com/s/lhwsnohy0e8sv2np109b6k05h5x4pcjv
https://app.box.com/s/xm0ak5sreba4cp7j5ivw1hddek5yx68z
The dates were not copying over because the date headers in both workbooks did not match. The macro will now clear the data in the costing tool before copying over the data from the quote. See how these revised files work for you.

 

[dpaton05]

We're almost there Mumps. Just a few more things I have noticed:

1. When I try and copy lines to the costing tool it seems to work fine, but if I try and copy more lines without clearing the lines already in the costing tool, the new lines get pasted below the table instead of into the table.
2. Each time row/s are pasted into the table, I need the whole table to be sorted into date order, earliest to most recent.

Thank you again for helping Mumps, you have been a life saver. I need to do this for my job and I couldn't work out how to get it done.
Dave

 

[mumps]

Try this macro. I have commented out the line in the macro which clears the Costing data each time the macro is run. If you want to clear that data, remove the apostrophe at the far left of that line of code as indicated.

Private Sub CmdSend_Click()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim desWS As Worksheet, srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet")
    Set desWS = Workbooks("Costing tool.xlsm").Sheets("Home")
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, x As Long, header As Range
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
    lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lastRow2 < 5 Then lastRow2 = 5
    'desWS.Range("A5:H" & lastRow2).ClearContents  'uncomment if you want the macro to clear the Costing data
    
    With srcWS.Range("A:A,B:B,H:H")
        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
    End With
    
    With desWS
        .Range("D" & lastRow2 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
        .Range("F" & lastRow2 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
        .Range("G" & lastRow2 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
    End With
    desWS.ListObjects("tblCosting").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting").Sort.SortFields. _
        Add Key:=desWS.Range("tblCosting[Date" & Chr(10) & "mm/dd/yy]"), 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

 

[dpaton05]

I tried that line of code Mumps and whenever I try and copy some rows to the costing tool, they copy correctly but they do not sort by date in tblCosting from the earliest date. When I try and copy rows, I get an error message saying "Method 'Range' of object '_Worksheet' failed" and I don't know what to do. I think that may be affecting the ability to sort the table, just as I have already mentioned, isn't working.


I have uploaded the files so you can see.

https://www.dropbox.com/s/fgjel44lf5g7eui/quoting tool 5.4.xlsm?dl=0
https://www.dropbox.com/s/rdjkfdxkiz5ad95/Costing tool.xlsm?dl=0

Thanks Mumps,
Dave

 

[mumps]

A couple of problems: You renamed the table in the Costing tool from "tblCosting" to "tblCosting2" so the macro had to be adjusted. You also made changes to the part of the macro that does the sorting. Below is the macro with the fixes that worked for me. Also, keep in mind that if you are using the macro in a different workbook other than the ones you uploaded, there could be many reasons why the macro is not working properly for you.

Private Sub CmdSend_Click()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim desWS As Worksheet, srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet")
    Set desWS = Workbooks("Costing tool.xlsm").Sheets("Home")
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, x As Long, header As Range
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
    lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lastRow2 < 5 Then lastRow2 = 5
    'desWS.Range("A5:H" & lastRow2).ClearContents  'uncomment if you want the macro to clear the Costing data
    
    With srcWS.Range("A:A,B:B,H:H")
        lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        desWS.ListObjects.Item("tblCosting2").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
    End With
    
    With desWS
        .Range("D" & lastRow2 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
        .Range("F" & lastRow2 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
        .Range("G" & lastRow2 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
    End With
    
    desWS.ListObjects("tblCosting2").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting2").Sort.SortFields. _
        Add Key:=desWS.Range("tblCosting2[Date]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("tblCosting2").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Application
        .CutCopyMode = False
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[dpaton05]

Thank you so much Mumps, that is perfect!! I need to go to bed now but I will get back to you when I can as there were a few things I noticed.

 

[dpaton05]

Could you help me with a few more problems please Mumps?

1. When you copy some rows to the costing tool, it puts the items in the rows under the headings but any of the info that is above the table, for instance, Organisation or Case worker, it replaces the headings with whatever value is in those fields as well as putting it below in the table.

2. I have created an additional button and a text box below the table npss_quote in the worksheet npss_quote_sheet. The point of this text box is to enter a value for the option,
Miscellaneous. In the table, I have also created a new column called Miscellaneous in column N of NPSS_quote_sheet. I want to be able to choose Miscellaneous from the service list
in npss_quote, so you would have a cell selected within that row, then move down to the text box and enter the miscellaneous cost. I then want it to be copied to the Miscellaneous
column for that row.

3. I have formula used by the United States Naval Observatory but I am not sure how to get it to work. This is the website I got it from: http://www.cpearson.com/excel/easter.aspx
I have tried to follow the instructions but I just can’t seem to get it to work. My Easter calculations are starting in G87 in the sheet named “sheet2”.



I have uploaded the most recent file. I have also combined the two files.
https://www.dropbox.com/s/twjlpx7naycqcg8/quoting tool 5.9.xlsm?dl=0

Thanks Mumps,
Dave

 

[mumps]

Click here for your file.
I have modified the Worksheet_Change macro to replace the action of the additional button and text box. Using the button and text box wouldn't have worked because once you click on the text box, the cell where you select "Miscellaneous" would lose focus so you also lose the reference to that row. When you now select "Miscellaneous" in column B, you will be prompted to enter a miscellaneous cost which will then be entered automatically into the appropriate cell in column N. Please note that the macro will force an entry. If you don't want to force an entry, please let me know and I will modify the macro. You didn't mention if you wanted the miscellaneous cost from column N to be copied to the Costing Tool sheet. If you want it copied, let me know into which column of the Costing tool. Have a look at Sheet2 to see if it is now working as you want. You can delete the "Public Function EasterUSNO(YYYY As Long) As Long" macro because the calculation in the sheet is being done by the formula.

 

[dpaton05]

Thanks Mumps, that is AWESOME!! The miscellaneous section should have been Activities, but I have changed that all, no problems. One more thing I have noticed that I need help with. Every service that is entered will incur GST, which is a tax imposed by the australian government. Activities will not incur GST though so I was trying to update the formula in H16 to reflect this. It needs to be the sum of the Price ex. GST for all services that are not Activities multiplied by 0.1. It also needs the rounddown function as part of the formula, with 2 decimal places too. I thought I could use the sumif and rounddown function. So round down the sum of all the prices that are not activities but it wouldn't work. I tried to include the not = to activities part as "<>Activities" but that wasn't working so I was wondering if you had any ideas.

This is my attempt

=ROUNDDOWN(SUMIF("npss_quote[Service]
ex. GST]","<>"&"Activities",npss_quote[Price 
ex. GST])*0.1,2)

Thanks Mumps,
Dave