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

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,770
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
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,002
No worries Dp.

I hope its all working for you now.

Cheerio,
vcollio.
 

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,002
You're welcome Dp.

I'm glad to have been able to assist and thanks for the feed-back.

Cheerio,
vcoolio.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,770

ADVERTISEMENT

I have had to change my spreadsheet and it won't work now. I tried to alter the code but the cancel feature still won't work.

This is my totals sheet now, where the tools need to go. The tool to update the purchase order number if a request number is known works but the cancel feature doesn't work.
CSS Work Allocation Sheet.22.xlsm
ABCDEFG
1Total ex GSTGSTTotal inc GST
2July000
3August000
4September000
5October000
6November000
7December000
8January000
9February000
10March000
11April000
12May000
13June000
14
15Updating purchase order number
16Enter a request number first, followed by the relevant purchase order number
17Request number
18
19Purchase order number
20
21
22Cancelling an order
23Enter
24Request number
25
26Date
27
28
Totals
Cell Formulas
RangeFormula
B2B2=SUM(July!H:H)-SUM(July!H$1:H$3)
C2:C13C2=B2*0.1
D2:D13D2=C2+B2
B3B3=SUM(August!H:H)-SUM(August!H$1:H$3)
B4B4=SUM(September!H:H)-SUM(September!H$1:H$3)
B5B5=SUM(October!H:H)-SUM(October!H$1:H$3)
B6B6=SUM(November!H:H)-SUM(November!H$1:H$3)
B7B7=SUM(December!H:H)-SUM(December!H$1:H$3)
B8B8=SUM(January!H:H)-SUM(January!H$1:H$3)
B9B9=SUM(February!H:H)-SUM(February!H$1:H$3)
B10B10=SUM(March!H:H)-SUM(March!H$1:H$3)
B11B11=SUM(April!H:H)-SUM(April!H$1:H$3)
B12B12=SUM(May!H:H)-SUM(May!H$1:H$3)
B13B13=SUM(June!H:H)-SUM(June!H$1:H$3)


This code is in the Totals sheet module
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

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

Call Test
Call SortCells
End Sub

This is the relevant code in this workbook
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, CancelReq As Range, CancelDate As Range
    'Select Case WorksheetFunction.Proper(sh.Name)
    With Sheets("Totals")
            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 With
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", "Cancellations")
        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

This is the code in a module.
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

Sub SortCells()

Range("A4", Range("O" & Rows.Count).End(xlDown).Address).Sort _
Key1:=Range("A4"), Order1:=xlAscending

End Sub

Thanks for your help :)
 

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,002
Hello Dp,

I'm not exactly sure what you're trying to do.

Rich (BB code):
I tried to alter the code but the cancel feature still won't work.

What doesn't work?
Are you receiving an error message?
Are you now using the Totals worksheet to determine which data is to be transferred to the Cancellations worksheet and then deleting the source rows from the source sheets?

Cheerio,
vcoolio.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,770

ADVERTISEMENT

The spreadsheet still has 14 sheets,
  • A sheet for every month of the year
  • A Totals sheet
  • A Cancellations sheet
The totals sheet is now to have the tools. I have put the tools both on that sheet and tried to change the code but it doesn't work and as I don't really understand the code you wrote, I can't really debug it.

The totals sheet now has a section that looks like this:
CSS Work Allocation Sheet.23.xlsm
ABCDEFG
15Updating purchase order number
16Enter a request number first, followed by the relevant purchase order number
17Request number
18
19Purchase order number
20
21
22Cancelling an order
23Enter a request number first, followed by the date
24Request number
25
26Date
27
Totals


These are the working features
  • If you enter a request number in B18 and an x in B20, all the purchase order numbers relating to that request number will be cleared.
These are the partially working features
  • The feature to enter the request number in B18 and then the purchase order number in B20 seems to work, although, it was giving me an error. The problem is that it only seemed to do it once and now I can't replicate it to describe it.
    • Although, the error just occurred again. I selected all the monthly sheets and tried to enter a 1 in the first row for the request number and I got that error.
    • I can go through the sheets one by one and enter in the same figure in the request number field and I will not get the error.
These features don't work
  • If you enter a request number in B25 and then the date in B27, I get the error "Method 'Intersect of object '_Global' failed". I press end and the numbers are not cleared from the cells and the relevant row is not moved from the monthly sheet that it is in to the cancellations sheet.
  • When I try and delete things from B27, I get the same error.
    • Just a reminder, The data in the cancellations sheet has to starts in row 4 as there are headings and other things in rows 1:3

Thanks for your continued help.
 
Last edited:

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,770
When I press debug, the line of code in bold is highlighted

VBA Code:
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)
    With Sheets("Totals")
            Set Req = Range("B18")
            Set PO = Range("B20")
            [B]If Not Intersect(Target, PO) Is Nothing Then[/B]
                Application.EnableEvents = False
                If PO <> "" And Req <> "" Then Call UpdateEverySheet(Req, PO)
                PO.ClearContents
                Req.ClearContents
                Application.EnableEvents = True
            End If
    End With
End Sub
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,770
This line

If Not Intersect(Target, PO) Is Nothing Then

Just so you don't miss all my posts, I have entered 2 other posts before this one.
 

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,002
Hello Dp,

You implied that the code(s) I gave you don't work after you made the changes however you now say that the error arises in the code in post #68 which I didn't write.
Even so, I don't see why that code wouldn't work.

BTW, in the sample you supplied in post #19, I placed my change event code in the Totals sheet module and amended the target to B27. I also altered the
Sub Test() to reflect the Totals sheet code and all worked as it should from the Totals sheet, no problems at all.
In the Sub Test(), did you change these lines of code:-
VBA Code:
Dim Req As String: Req = sh.[F1].Value
Dim Dt As String: Dt = sh.[H1].Value

to
VBA Code:
Dim Req As String: Req = Sheet2.[B25].Value  '---->Sheet2 is the Totals sheet.
Dim Dt As String: Dt = Sheet2.[B27].Value    '---->Sheet2 is the Totals sheet.
???????

You may have to upload another desensitised sample of your workbook.

Cheerio,
vcoolio.
 

Watch MrExcel Video

Forum statistics

Threads
1,113,774
Messages
5,544,142
Members
410,595
Latest member
Tatum2020
Top