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

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
ABCDEFGHIJKLMNOP
1501 CSS JulyEnter Req # in F1, then a PO # in H1 and the entire spreadsheet will be auto populatedReq #Purchase order #If you enter a Req # and the letter x in the PO #, every PO # against the Req # will be cleared.
2
3DatePurchase order #Req #Child NameServiceRequesting OrganisationCaseworker NamePrice ex. GSTGSTPrice inc. GSTAllocated toDate report receivedDate report sentAllocated byReport sent byReport 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
ABCDEFGHIJKLMNOP
1501 CSS CancellationsEnter request number and date to cancelReq #Date
2
3DatePurchase order #Req #Child NameServiceRequesting OrganisationCaseworker NamePrice ex. GSTGSTPrice inc. GSTAllocated toDate report receivedDate report sentAllocated byReport sent byReport 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:
VBA Code:
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Hello DP,

See if the following works for you. Test it in a copy of your workbook (as I haven't tested it!).
VBA Code:
Sub Test()

        Dim ws As Worksheet, sh As Worksheet
        Set sh = Sheets("Cancellations")
        Dim Req As String: Req = sh.[F1].Value
        Dim Dt As String: Dt = sh.[H1].Value
        
Application.ScreenUpdating = False
        
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, Dt
                                .AutoFilter 3, Req
                                .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                                .Offset(1).EntireRow.Delete
                                .AutoFilter
                        End With
                End If
        Next ws
        
sh.Range("F1", "H1").ClearContents
        
Application.ScreenUpdating = True

End Sub

Assign the code to a button on the "Cancellations" sheet.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
Thanks for the reply, I have not tried your code yet but I was wondering if it could be attached to the worksheet so after H1 is updated on the cancellations sheet, the code is executed.

This is similar to the code I have in the first post, which executes when H1 is updated on each of the sheets.
 
Upvote 0
I just tried the code and I get an error Autofilter method of range class failed and this line of code is highlighted.

VBA Code:
.AutoFilter 1, Dt
 
Upvote 0
Does it make a difference that there are sheets for each month of the year, plus a sheet called Totals and a sheet called Cancellations?
 
Upvote 0
Hello Dp,

Leave the code in post #2 in a standard module and in the Cancellations sheet module , place this code:-

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

Test

End Sub

This will eliminate the need for a button.

I've just created a mock-up of what your workbook may look like based on your opening post and the code works exactly as it should.
That error would be caused by the fact that there is another sheet which needs to be excluded (Totals). Hence, amend the main code as follows:-

VBA Code:
Sub Test()

        Dim ws As Worksheet, sh As Worksheet
        Set sh = Sheets("Cancellations")
        Dim Req As String: Req = sh.[F1].Value
        Dim Dt As String: Dt = sh.[H1].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 3, Req
                                .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                                .Offset(1).EntireRow.Delete
                                .AutoFilter
                        End With
                End If
        Next ws
        
sh.Range("F1", "H1").ClearContents
        
Application.ScreenUpdating = True

End Sub

Here's hoping!

Cheerio,
vcoolio.
 
Upvote 0
Where do I include the code in the last post under the sub test?
 
Upvote 0
Hello Dp,

Go to the VB Editor (press Alt+F11). Select "Insert" from the ribbon at the top then select 'Module'. Paste the code in the big white code field.

Cheerio,
vcoolio.
 
Upvote 0
I still get auto filter method of range class failed with that same line highlighted as before.
 
Upvote 0
Rich (BB code):
.............The pages are very similar.........

Are all the source sheets set out exactly the same?
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top