Copying quote rows from monthly sheets to cancellation sheet if criteria is met

[dpaton05]

I have sheets for every month of the year. All these sheets are the same and have the following format.

CSS Work Allocation Sheet.3.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	501 CSS July			Enter Req # in F1, then a PO # in H1 and the entire spreadsheet will be auto populated	Req #		Purchase order #			If you enter a Req # and the letter x in the PO #, every PO # against the Req # will be cleared.
2
3	Date	Purchase order #	Req #	Child Name	Service	Requesting Organisation	Caseworker Name	Price ex. GST	GST	Price inc. GST	Allocated to	Date report received	Date report sent	Allocated by	Report sent by	Report sent by
4
5
6
7
8
July

As I mentioned. there are sheets for each month of the year, this is just the July sheet and they are all the same. The monthly sheets record quotes and I have another sheet called Cancellations, which is below.

CSS Work Allocation Sheet.3.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	501 CSS Cancellations			Enter request number and date to cancel	Req #		Date
2
3	Date	Purchase order #	Req #	Child Name	Service	Requesting Organisation	Caseworker Name	Price ex. GST	GST	Price inc. GST	Allocated to	Date report received	Date report sent	Allocated by	Report sent by	Report sent by
4
5
Cancellations

The pages are very similar and the cancellations sheet is just an area to record quotes that have been cancelled.



I have been helped with code to update every request number in the document with a purchase order number and that code goes in the ThisWorkbook module. The code is as follows:

Option Explicit
'this is triggered whenever cell H1 is amended in any of the listed sheets
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim Req As Range, PO As Range
    Select Case WorksheetFunction.Proper(sh.Name)
        Case "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
            Set Req = sh.Range("F1")
            Set PO = sh.Range("H1")
            If Not Intersect(Target, PO) Is Nothing Then
                Application.EnableEvents = False
                If PO <> "" And Req <> "" Then Call UpdateEverySheet(Req, PO)
                PO.ClearContents
                Req.ClearContents
                Application.EnableEvents = True
            End If
    End Select
End Sub
'this is called by Sheet_Change and loops through all monthly sheets creating required entries
Private Sub UpdateEverySheet(Req As Range, PO As Range)
    Dim sh, ws As Worksheet, Cel As Range, ReqRng As Range
    If UCase(PO) = "X" Then PO = ""
    For Each sh In Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
        Set ws = Sheets(sh)
        Set ReqRng = ws.Range("C4", ws.Range("C" & Rows.Count).End(xlUp))
        For Each Cel In ReqRng
            If Val(Cel) = Val(Req) Then Cel.Offset(, -1) = PO
        Next Cel
    Next sh
End Sub

The code allows for a request number and a purchase order number to be entered. After the PO# is entered

• Both cells are cleared
• Every instance of the request number within the document is updated so that quote with that request number, gets the PO# entered for the quote.

This is what I want to be able to do

• Enter a request number and a date in F1 and H1 of the Cancellations sheet
• After entering both I need the quote that matches the request number and date that I have just entered in F1 and H1 to be found in the workbook
• When found I need it moved from the sheet where it is to the cancellations sheet.
• Entries below where it quote row was moved from, need to be moved up one row to fill the gap where it was.
• As with feature to insert the PO# from a given request number, I need F1 and H1 cleared after the row has been moved

I tried to look at the code and I thought I might be able to work it out myself but I can't work it out.

Can someone help me please with the code to make this happen as I don't know how to code it?

Thanks

 

[dpaton05]

With this code that you helped me with, I am trying to make a similar feature but having trouble with it and was hoping if you could help me please?

Sub Transfer()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet
        Set sh = Sheets("Totals")
        Set sht = Sheets("Cancellations")
        Dim Req As String: Req = sh.[B25].Value
        Dim Dt As String: Dt = sh.[B27].Value
    
Application.ScreenUpdating = False
    
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, Dt           ' autofilter for the value in cell [B27]
                                .AutoFilter 3, Req          ' autofilter for the value in cell [B25]
                                .Offset(1).EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                .Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
        Next ws
    
sh.Range("B25,B27").ClearContents
Application.ScreenUpdating = True

End Sub

This code finds a cancelled job and moves it to the cancellations sheet. If the job is a late cancel, the job is not moved anywhere. All that needs to be done is the job needs to be found within the monthly sheets, then the service for the job needs to be copied to B30 and the date needs to be copied to A30 on this table:

CSS Work Allocation Sheet.36.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
27	Late Cancel
28
29	Date	Service	Unit Price	Day rate	Hours	Staff Req.	Kms Travelled	Price ex. GST	Rate	Transport $	MaxPay	Column3	Activities	Column1	Column2	Column22	Column23
30	06/07/2020	Supervised Contact	$71.10	Business_day_rate	3	1		#N/A	#N/A	$0.00	#N/A			0	0
Sheet2

Cell Formulas
Range	Formula
C30	C30	=IF([@Service]="Activities",[@Activities],INDEX(Service_Types,MATCH([@Service],Sheet2!$A$5:$A$12,0),MATCH([@[Day rate]],Sheet2!$A$5:$E$5,0)))
D30	D30	=IF(A30="","",IF(COUNTIF('[CSS Work Allocation Sheet.35.xlsm]Sheet2'!$G$87:$DO$97,A30),"Public_holiday",IF(WEEKDAY(A30)=1,"Sun",IF(WEEKDAY(A30)=7,"Sat","Business_day_rate"))))
H30	H30	=IF([@Service]="Activities",ROUNDDOWN('CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@Activities]+'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@[Transport $]],2),IF('CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@Service]="Carer Respite",'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@[Staff Req.]]*'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@Rate],ROUNDDOWN(((IF(OR(ISBLANK(A30),ISBLANK(D30),ISBLANK(B30)),0,'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@[Transport $]]+'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@MaxPay]))*'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@[Staff Req.]]),2)))
I30	I30	=INDEX('[CSS Work Allocation Sheet.35.xlsm]Sheet2'!$A$5:$E$12,MATCH('CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[Service],'[CSS Work Allocation Sheet.35.xlsm]Sheet2'!$A$5:$A$12,0),MATCH('CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[Day rate],'[CSS Work Allocation Sheet.35.xlsm]Sheet2'!$A$5:$E$5,0))
J30	J30	=('CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[@[Kms Travelled]]*1.22)
K30	K30	='CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[Rate]*'CSS Work Allocation Sheet.35.xlsm'!tblLtCancel[Hours]
N30	N30	=IF(B30="Supervised transport",1,0)
O30	O30	=IF(B30="Supervised transport",1,0)

Cells with Data Validation
Cell	Allow	Criteria
A30	Any value
B30	List	=Service_List

I was trying to write a sub that would copy the service from the row in the filtered results and put it in B30 of sheet2. I was thinking I could then use it to recalculate the price as a late cancel will be a 3hr minimum and once I have the service it B30, it would also put the date in A30 which would give me a price. I then needed the price copied back to the price. ex gst cell in the filtered row.

To begin with, I tried to write this code but it wouldn't work so I thought that I wouldn't try and go any further yet.

Public Sub LCancel()
        Dim ws As Worksheet, sh As Worksheet, DataSht As Worksheet
        Set sh = Sheets("Totals")
        Set DataSht = Sheets("Sheet2")
        Dim LateReq As String: LateReq = sh.[B32].Value
        Dim LateDt As String: LateDt = sh.[B34].Value
       
Application.ScreenUpdating = False
       
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, LateDt           ' autofilter for the value in cell [B27]
                                .AutoFilter 3, LateReq          ' autofilter for the value in cell [B25]
                               
                                .Offset(1, 5).Copy DataSht.Range("B30")
                                '.Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
        Next ws
       
sh.Range("B25,B27").ClearContents
Application.ScreenUpdating = True
End Sub

When this is done, I need some text "Lt Cancel" added before the date in A30.

 

[dpaton05]

When I try and run the above code, I get the error method intersect of global object failed and if I press debug, the line of code

If Not Intersect(Target, PO) Is Nothing Then

is highlighted in the following procedure.

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim Req As Range, PO As Range, CancelReq As Range, CancelDate As Range
    
    Select Case WorksheetFunction.Proper(sh.Name)
        Case "Totals" 'Case "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December", "Cancellations"
            Set Req = Range("B18")
            Set PO = Range("B20")
            If Not Intersect(Target, PO) Is Nothing Then
                Application.EnableEvents = False
                If PO <> "" And Req <> "" Then Call UpdateEverySheet(Req, PO)
                PO.ClearContents
                Req.ClearContents
                Application.EnableEvents = True
            End If
    End Select
End Sub

 

[dpaton05]

When the above code is run, despite giving an error, the named range is deleted and all the formulas except the ones in N30 and O30.

 

[vcoolio]

Hello Dp,

Please start a new thread for your latest query as it is a new aspect of your ongoing project. This thread has become far too long.

Cheerio,
vcoolio.