Posts by fess67

Thanks for taking the time to look Roy,

There are 2 sheets pertinent to the code. HTL and Tracking.

StatusRng is on the HTL sheet. The Tracking sheet is hidden and will not be used in everyday work, it is trying to capture dates of events to build up a timeframe of work passing though the facility.

Vlookup is taking the selected cell in StatusRng and looking across to pick up the order number. In the attached, simplified workbook, that is col C.

The order number is a constant allocated by the sales team. On occasion there will be no order number and these should be ignored which is why I put in the If IsEmpty statement.

I have attached a cut down workbook. When a status is applied in the HTL sheet the code does the following:

1. Check if order number exists - if no then exit
2. If order number exists then check Tracking sheet for that order number
3. If order number does not exist on Tracking sheet, write to new row and enter date in relevant status column
4. If order number does exist on Tracking sheet, find row and enter date in relevant status column.

Works fine on single changes however not on copy / paste of several rows. So if the user wants to change 10 rows to a status of Production he is changing the first one then copying that status and pasting to the remaining rows. That throws a type mismatch error on Ln73 of the code which is between the two Case statements.

CurrRow = Application.WorksheetFunction.Match(result, ws.Range("B:B"), 0)

In order to get things working again I need to stop the debugger and in the immediate window run Application.EnableEvents = True

Cheers,

Hi, I have reached the limit of my ability on this one. My code checks for an order number and if it exists updates a tracking sheet with todays date. If the order number does not exist it creates a record on the tracking sheet and records todays date in the relevant status code. Works great for single instances however the user needs to be able to copy and paste a batch of statuses at once and the code is not running in that instance.

I am sure the select case can be written better however that is not the primary concern at the moment. Also, the error handling is there just to prevent error messages until I can sort out the functionality.

Can you please help me fire the Select Case when the change event is a copy & paste or even an autofill drag.

Thanks in advance.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim StatusRng As Range
Dim Rng As Range
Dim LastRow As Long, CurrRow As Long
Dim ws As Worksheet

On Error Resume Next

Set ws = Worksheets("Tracking")

Application.EnableEvents = True

Set StatusRng = Intersect(Application.ActiveSheet.Range("B3:B5000"), Target)
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

If Not StatusRng Is Nothing Then
    Application.EnableEvents = False
        For Each Rng In StatusRng
            If Not VBA.IsEmpty(Rng.Value) Then
            
 'check if the production order is empty.  If it is then exit the routine
 
            If IsEmpty(Selection.Offset(0, 11)) Then
                Application.EnableEvents = True
                Exit Sub
                Else
            
   'check to see if the production order already exists in the Tracking sheet
   
                result = Application.VLookup(Selection.Offset(0, 11).Value, Sheets("Tracking").Range("B2:B5000"), 1, False)

 'if this is a new record then write to the Tracking sheet
 
            If IsError(result) Then
            
                Sheets("Tracking").Range("B" & LastRow) = Selection.Offset(0, 11).Value
                CurrRow = LastRow
                
            Select Case Rng.Value

            Case "Materials"
                ws.Range("C" & CurrRow) = Date
            Case "Upcoming"
                ws.Range("D" & CurrRow) = Date
            Case "Ready"
                ws.Range("E" & CurrRow) = Date
            Case "Scheduled"
                ws.Range("F" & CurrRow) = Date
            Case "In Production"
                ws.Range("G" & CurrRow) = Date
            Case "Finished"
                ws.Range("H" & CurrRow) = Date
            Case "3rd Party"
                ws.Range("I" & CurrRow) = Date
            Case "Engineering"
                ws.Range("J" & CurrRow) = Date
            Case "Cancelled"
                ws.Range("K" & CurrRow) = Date
            Case "Hold"
                ws.Range("L" & CurrRow) = Date
            End Select
                
            ws.Range("A" & LastRow) = LastRow
            
                
            Else
 'Apend the existing record with the updated status
 
           CurrRow = Application.WorksheetFunction.Match(result, ws.Range("B:B"), 0)
          
            
            Select Case Rng.Value

            Case "Materials"
                ws.Range("C" & CurrRow) = Date
            Case "Upcoming"
                ws.Range("D" & CurrRow) = Date
            Case "Ready"
                ws.Range("E" & CurrRow) = Date
            Case "Scheduled"
                ws.Range("F" & CurrRow) = Date
            Case "In Production"
                ws.Range("G" & CurrRow) = Date
            Case "Finished"
                ws.Range("H" & CurrRow) = Date
            Case "3rd Party"
                ws.Range("I" & CurrRow) = Date
            Case "Engineering"
                ws.Range("J" & CurrRow) = Date
            Case "Cancelled"
                ws.Range("K" & CurrRow) = Date
            Case "Hold"
                ws.Range("L" & CurrRow) = Date
            End Select
            
        End If
        End If
        End If
     Next

    Application.EnableEvents = True
End If
End Sub

Re: AUD $500 - Modify existing code to consolidate into and streamline

Payment sent. Thank you very much

Re: AUD $500 - Modify existing code to consolidate into and streamline

That ran this weeks statements perfectly. Thanks.

I will make payment today. I am away for the rest of the week and although I do not expect any issues when I return may I Approach to for any bug fixes if they arise?

Thanks

Re: AUD $500 - Modify existing code to consolidate into and streamline

No joy. Run time error 438...Object doesn't support this property or method.

costCodeWorksheetName = costCodeWorkbook.Sheets(1)

I have tried it with files named 'Cost code' and 'Report' and the same error is encountered.

Re: AUD $500 - Modify existing code to consolidate into and streamline

Run time error

formulaRange.FormulaR1C1 = "=IFERROR(MATCH(""Total for INV ""&RC[1]&""*"",'[" & costCodeWorkbook.Name & "]cost code'!R1C2:R65000C2,0),""DELETE"")"

I have uploaded the current files into dropbox, including the new Cost code statement. I read your notes in the code as to the reason this error would be thrown up however all files including the cost code file are .xlsx

Thanks

Re: AUD $500 - Modify existing code to consolidate into and streamline

Looks good on the test files that I sent you. I will do a full statement run hopefully this afternoon, tomorrow morning at the latest and will make payment if all ok. I do not expect any issues.

Thanks for your effort.

Re: AUD $500 - Modify existing code to consolidate into and streamline

yep. was away for the weekend. You should have an email.

Cheers

Re: AUD $500 - Modify existing code to consolidate into and streamline

ok GC,

Send me the macro and I will test my end tomorrow. Thanks

Re: AUD $500 - Modify existing code to consolidate into and streamline

Correct. Points to note:

• SO's code takes sheets that I create and cross-references with a master. It removes any invoices from the individual sheets and the result is the sheet seen in 40405.
• At this stage the entries in Col G are incorrect. As the SUM was done prior to the invoice removal stage. Col G requires a SUM for each week ending
• The W/ Ending dates in Col D should reflect the date in Col F for each week ending. Originally there was only one header hence only one date.
• For some reason - SO's code fails with a runtime if my master is anything other than .XLS - if we can find a way around that it would be great but not a deal breaker.

That's it I think.

Re: AUD $500 - Modify existing code to consolidate into and streamline

I am under no set time limit as such and our geographical separation will add delay anyway - which is not an issue. I would love to have it up and working robustly by 3rd week of July. I am due to go away at the end of July and really need to be able to delegate the process so that I do not have to log in remotely.

My vision for this is that once I have collated the required files from my database, I am then able to activate a macro / script and the output will be as shown in the full statement above (slight edit to that coming up but that is an easy fix).

If you can get me there in 3 or 4 weeks the work is yours.

S.O. developed some code for me. I want to take it another step further and, if we can, integrate the existing code to make this as much of a 1 click option as we can.

It takes me considerable time to complete this work every Monday and I am unable to hand it off at the moment. Hence the decent payment amount. I do not think this is hard to do, just that I really want it done

With the work S.O. has already done I am left with up to 20 spread sheets similar to the 40405-P084 - file attached. Layouts are the same, just the number of week endings in Col F will differ.

I want to take all those sheets, and consolidate into 1 single workbook - as shown in the attached file Ozgrid Full Statement.

Background info and the original work can be seen http://www.ozgrid.com/forum/showthread.php?t=194330

forum.ozgrid.com/index.php?attachment/65788/forum.ozgrid.com/index.php?attachment/65789/

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

SUCCESS!!!!!

If I save my cost code statement straight from the database output as .xls rather than opening and saving as .xlsx the code runs fine.

Thanks you for your effort and patience - this is going to save me a lot of time and with automation I will also be able to hand it off in time. Delegated work makes me a happy camper

Please let me know your details for payment.

Thanks again

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

Well, I think we are getting somewhere BUT it has me beat as well - Let me explain

I can get it to work. It works with one of the attached cost code files (cost code test) but does not work with the other file (newSave)

I am not aware of having done anything different with cost code test. However, the newSave file is how it comes from our reporting system. Whatever I did to create that I need to try to replicate. I can see no difference in the two files.

Is there a way I can PM you the full files rather than post them publically - Then I can give you the full original rather than stripping info?

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

Still getting the run time error

formulaRange.FormulaR1C1 = Replace("=IFERROR(MATCH(""Total for INV ""&RC[1]&""*"",'[" & costCodeWorkbook.Name & "]cost code'!C2,0),""DELETE"")", ",", Application.International(xlListSeparator))
.Range("A6:G6").AutoFilter field:=1, Criteria1:="DELETE"

This happens when I press the GO button after selecting the cost code sheet and folder in steps 1 and 2. The cost code sheet is in the parent folder and the cost centre sheets are in a sub folder. There are no other files in the sub folder other than 2 cost centre sheets

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

Yes the 222222 workbook.

Sorry I do not understand the comment about commas or semi-colons.

Here is the workflow I am trying:

• Open 'cost code' spreadsheet. It is in the same folder as the '222222' There is also another sheet there called '40405'
• Open the VBA project through the Developer tab in Excel
• Run the code
• It firsts asks me to select the folder
• I am then asked to select the 'cost cose (sic) workbook' - I take this to mean cost code. I select that and I get the run time error.
• I tried it by opening '222222' in step 5. Still get run time error
• I tried running it with no sheet open - same result.
• The only things in the folder are 'cost code', '222222', and '40405'.

I am happy to open the worksheet manually and run the code on each individual one if that will help.

Thanks

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

Run time error 1004

formulaRange.FormulaR1C1 = "=IFERROR(MATCH(""Total for INV ""&RC[1]&""*"",'[" & costCodeWorkbook.Name & "]cost code'!C2,0),""DELETE"")"

[ATTACH=CONFIG]65008[/ATTACH]

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

Thanks

I have tried again with the same result in that it runs but does not remove the unmatched entries. My gut feel is there is an issue with the if(match( statement. It would appear that the identification, filtering and deletion of required entries is not working. I tried stepping through the code with ScreenUpdating off to see if I could figure out where it might be going wrong but that part of it just loops to the end. Of course I may be way off track as well

Referring to the files supplied in the original post this is what should happen when the code is run:

• in file '222222' - all rows from 7 to 136 should be deleted.
  
  
  • This is because the first match is invoice 18872 in A137 of '222222' - found in 'cost code' B23 or B25 (looks like your code references B25 but either works.)

  
  

• in file '222222' - the next row to be deleted is row 153
  
  
  • This is because invoice 19340 is not present in col B of the 'cost code' file.

  
  

Is that how it is working at your end?

Cheers

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

Hi S O,

I have run the code. It does not do as expected in that no rows are deleted from the 'target' workbook, in this case 222222.

I guess I need to qualify that I am operating it as you intended so, some questions:

• Which workbooks should I have open? cost code, 222222 or none?
• Which workbook should be the active one when the code is run?

When I ran the code it asked me to select a folder, then to select a file then it ran and gave a message box "Check complete". When I checked the files I saw no change to either file.

Cheers

Re: AUD $100 - Compare columns in two workbooks and remove row if match is negative

thanks