Am i on the right track

[Learningvbaexcel1]

I am in charge of the expiration dates of a large grocery distribution warehouse. Our inventory levels for any given item fluctuate with the season, holidays, etc. I may have one pallet in house or I may have hundreds.

I have been working on a macro that reorganizes the information into a manageable format and looks for problems with dates. The data right now is organized into 6 columns of information, all read into an array for faster processing.

My receivers don't always pay attention to the dates when they receive, so instead of putting 1/5/21, they may put 11/5/21 or other weird dates. There are other rules I have to follow, but once I get the base coding down, I can add the other rules easily enough.

I can get the information out of the array, but I think I'm missing something at the next part. I might be on the right track, but is there a more efficient way to do this?

Basically,

For i from 1 to Lastrow
set variable to first item number
While j is (equals) item number
Copy array row to work area
When j no longer equals item number
Process rules for this particular area
If errors found, post info to report
If no errors found, continue
Clear the work area
Get the next item number and repeat above

The database is already sorted by item number and then by expiration date. Since I don't know how many pallets I have of each item, I want it to be fluid.

Am I setting the variable in the right place? Is this the most efficient way to accomplish this task?

The other option I was considering is copying the item number to another area, and then comparing it, but that seems like a lot of extra code for the same task.

Thank you

 

[Zot]

Everyone is keying in into same PC or system or the data is keyed in on individual laptop or PC?

Then the problem would be instead of keying in dd/mm/yyyy, they could key in mm/dd/yyyy which might be valid date in on PC but not on other PCs. If everyone is enter date into a single PC then probably more manageable.

1/5/21 and 11/5/21 is just fine for both dd/mm/yy and mm/dd/yy systems. What are you trying to prevent actually?

 

[Learningvbaexcel1]

Everyone is keying in into same PC or system or the data is keyed in on individual laptop or PC?

Then the problem would be instead of keying in dd/mm/yyyy, they could key in mm/dd/yyyy which might be valid date in on PC but not on other PCs. If everyone is enter date into a single PC then probably more manageable.

1/5/21 and 11/5/21 is just fine for both dd/mm/yy and mm/dd/yy systems. What are you trying to prevent actually?

The recei ers all key into individual pcs, which then reports to a central database. That's where my report pulls the information from. The dates are always fixed to mm/dd/yyyy by the company and by the program they utilize to receive the freight.

The main issue I will be looking for is if I have two or more pallets in house, how far apart are the dates they receive. A typical product, received over 30 days, the dates should be no more than 45 days apart from beginning to end.

I can get that part to work easily enough once its in the workspace, because that's not the only rules I will be applying. The part I'm stuck on is just trying to get all the item numbers of one group to print in the workspace, let me run the rules I will code in, then move to the next set of item numbers.

 

[petertenthije]

Could you try this?
Note, this WILL delete data from worksheet SOURCESHEET when it is done with a specific product number, so be sure to test this on a backup!

It first makes a list with unique product numbers on worksheet PRODUCTS.
It then filter the products on your sourcesheet based on the first product number listed on worksheet PRODUCTS.
The filtered result is copied to worksheet CALCULATIONS.
Here you can do whatever you need to do.
It then removes the products from the source data and clear the filter.
Then it will remove the product from your productrs list.
From here the loop will restart. As long as there is data in row 2 of PRODUCTS the macro wil continue looping.

Sub test()

' https://www.mrexcel.com/board/threads/am-i-on-the-right-track.1156905/
'
' This macro assumes there are three worksheets
'
' The source data on worksheet named SOURCESHEET
' The products lists on worksheet named PRODUCTS
' The calculations are done on worksheet named CALCULATIONS

' This macro consists of several steps:
' Steps 2 through 5 are looped through a seperate macro.

' Step 1:   Identify the unique product numbers
' Start LOOP (submacro)
' Step 2:   Remove existing data from worksheet CALCULATIONS
' Step 3:   Copy over data to from SOURCESHEET to CALCULATIONS
' Step 4:   Here you can enter your own calcuations
' Step 5:   Clear product number from worksheet PRODUCTS
' END LOOP (/submacro)


'--------------------------------------
' S T E P   O N E
'--------------------------------------

' Remove current productcodes list from worksheet PRODUCTS.
    Sheets("Products").Visible = True
    Sheets("Products").Select
    Cells.Select
    Selection.ClearContents

' Copy the entire list of productcodes over to worksheet PROCUCTS
' It is assumed the products are listed in column A.
    Sheets("Calculations").Visible = True
    Sheets("Sourcesheet").Select
    Columns("A:A").Select
    Selection.Copy

' Paste the productcodes into worksheet PRODUCTS
    Sheets("Products").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

' Remove duplicates
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes

Call Submacro

End Sub

Sub Submacro()

'--------------------------------------
' S T E P   T W O
'--------------------------------------

' Check if loop is required
    Sheets("Products").Select
If IsEmpty(Range("A2")) = False Then


' Remove existing data from worksheet CALCULATIONS
    Sheets("Calculations").Visible = True
    Sheets("Calculations").Select
    Cells.Select
    Selection.ClearContents

' Select the source sheet
    Sheets("Sourcesheet").Visible = True
    Sheets("Sourcesheet").Select

' Clear any existing filters
If ActiveSheet.AutoFilterMode Then
   ActiveSheet.AutoFilterMode = False
End If

' Add new auto filter
    Range("A1:F1").AutoFilter



'--------------------------------------
' S T E P   T H R E E
'--------------------------------------

' Apply Filter
' The macro makes the following assumptions:
'   - The source data is in columns A to F
'   - There are no blank rows in column A
'   - The column filters on column A (see Field:=1)
    RowCount = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    ProductCode = Worksheets("Products").Range("A2")
    ActiveSheet.Range("A1:F" & RowCount).AutoFilter Field:=1, Criteria1:=ProductCode

' Copy rows selected on SOURCESHEET
    ActiveSheet.Range("A2:F" & RowCount).SpecialCells(xlCellTypeVisible).Copy

' Paste selected rows on CALCULATIONS
    Sheets("Calculations").Select
    Range("A1").Select
    ActiveSheet.Paste

'  Delete Rows from sourcesheet
    Sheets("Sourcesheet").Select
    Application.DisplayAlerts = False
        ActiveSheet.Range("A2:AZ" & RowCount).SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True

' Clear any existing filters
    Sheets("Sourcesheet").Select
If ActiveSheet.AutoFilterMode Then
   ActiveSheet.AutoFilterMode = False
End If


'--------------------------------------
' S T E P   F O U R
'--------------------------------------

' Go back to CALCULATIONS
    Sheets("Calculations").Select
   
    ' FROM THIS POINT ON YOU CAN DO YOUR OWN CALCULATIONS ON THE WORKSHEET



'--------------------------------------
' S T E P   F I V E
'--------------------------------------

' Remove the product number that has just been completed from worksheet PRODUCTS
    Sheets("Products").Select
    Range("A2").Select
    Rows("2:2").Delete Shift:=xlUp



Call Submacro


End If

End Sub

 

[Learningvbaexcel1]

Could you try this?
Note, this WILL delete data from worksheet SOURCESHEET when it is done with a specific product number, so be sure to test this on a backup!

It first makes a list with unique product numbers on worksheet PRODUCTS.
It then filter the products on your sourcesheet based on the first product number listed on worksheet PRODUCTS.
The filtered result is copied to worksheet CALCULATIONS.
Here you can do whatever you need to do.
It then removes the products from the source data and clear the filter.
Then it will remove the product from your productrs list.
From here the loop will restart. As long as there is data in row 2 of PRODUCTS the macro wil continue looping.

Sub test()

' https://www.mrexcel.com/board/threads/am-i-on-the-right-track.1156905/
'
' This macro assumes there are three worksheets
'
' The source data on worksheet named SOURCESHEET
' The products lists on worksheet named PRODUCTS
' The calculations are done on worksheet named CALCULATIONS

' This macro consists of several steps:
' Steps 2 through 5 are looped through a seperate macro.

' Step 1:   Identify the unique product numbers
' Start LOOP (submacro)
' Step 2:   Remove existing data from worksheet CALCULATIONS
' Step 3:   Copy over data to from SOURCESHEET to CALCULATIONS
' Step 4:   Here you can enter your own calcuations
' Step 5:   Clear product number from worksheet PRODUCTS
' END LOOP (/submacro)


'--------------------------------------
' S T E P   O N E
'--------------------------------------

' Remove current productcodes list from worksheet PRODUCTS.
    Sheets("Products").Visible = True
    Sheets("Products").Select
    Cells.Select
    Selection.ClearContents

' Copy the entire list of productcodes over to worksheet PROCUCTS
' It is assumed the products are listed in column A.
    Sheets("Calculations").Visible = True
    Sheets("Sourcesheet").Select
    Columns("A:A").Select
    Selection.Copy

' Paste the productcodes into worksheet PRODUCTS
    Sheets("Products").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

' Remove duplicates
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes

Call Submacro

End Sub

Sub Submacro()

'--------------------------------------
' S T E P   T W O
'--------------------------------------

' Check if loop is required
    Sheets("Products").Select
If IsEmpty(Range("A2")) = False Then


' Remove existing data from worksheet CALCULATIONS
    Sheets("Calculations").Visible = True
    Sheets("Calculations").Select
    Cells.Select
    Selection.ClearContents

' Select the source sheet
    Sheets("Sourcesheet").Visible = True
    Sheets("Sourcesheet").Select

' Clear any existing filters
If ActiveSheet.AutoFilterMode Then
   ActiveSheet.AutoFilterMode = False
End If

' Add new auto filter
    Range("A1:F1").AutoFilter



'--------------------------------------
' S T E P   T H R E E
'--------------------------------------

' Apply Filter
' The macro makes the following assumptions:
'   - The source data is in columns A to F
'   - There are no blank rows in column A
'   - The column filters on column A (see Field:=1)
    RowCount = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    ProductCode = Worksheets("Products").Range("A2")
    ActiveSheet.Range("A1:F" & RowCount).AutoFilter Field:=1, Criteria1:=ProductCode

' Copy rows selected on SOURCESHEET
    ActiveSheet.Range("A2:F" & RowCount).SpecialCells(xlCellTypeVisible).Copy

' Paste selected rows on CALCULATIONS
    Sheets("Calculations").Select
    Range("A1").Select
    ActiveSheet.Paste

'  Delete Rows from sourcesheet
    Sheets("Sourcesheet").Select
    Application.DisplayAlerts = False
        ActiveSheet.Range("A2:AZ" & RowCount).SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True

' Clear any existing filters
    Sheets("Sourcesheet").Select
If ActiveSheet.AutoFilterMode Then
   ActiveSheet.AutoFilterMode = False
End If


'--------------------------------------
' S T E P   F O U R
'--------------------------------------

' Go back to CALCULATIONS
    Sheets("Calculations").Select

    ' FROM THIS POINT ON YOU CAN DO YOUR OWN CALCULATIONS ON THE WORKSHEET



'--------------------------------------
' S T E P   F I V E
'--------------------------------------

' Remove the product number that has just been completed from worksheet PRODUCTS
    Sheets("Products").Select
    Range("A2").Select
    Rows("2:2").Delete Shift:=xlUp



Call Submacro


End If

End Sub

Thank you. I will give it a try. Even if it doesn't quite work as you wrote it

Could you try this?
Note, this WILL delete data from worksheet SOURCESHEET when it is done with a specific product number, so be sure to test this on a backup!

It first makes a list with unique product numbers on worksheet PRODUCTS.
It then filter the products on your sourcesheet based on the first product number listed on worksheet PRODUCTS.
The filtered result is copied to worksheet CALCULATIONS.
Here you can do whatever you need to do.
It then removes the products from the source data and clear the filter.
Then it will remove the product from your productrs list.
From here the loop will restart. As long as there is data in row 2 of PRODUCTS the macro wil continue looping.

Sub test()

' https://www.mrexcel.com/board/threads/am-i-on-the-right-track.1156905/
'
' This macro assumes there are three worksheets
'
' The source data on worksheet named SOURCESHEET
' The products lists on worksheet named PRODUCTS
' The calculations are done on worksheet named CALCULATIONS

' This macro consists of several steps:
' Steps 2 through 5 are looped through a seperate macro.

' Step 1:   Identify the unique product numbers
' Start LOOP (submacro)
' Step 2:   Remove existing data from worksheet CALCULATIONS
' Step 3:   Copy over data to from SOURCESHEET to CALCULATIONS
' Step 4:   Here you can enter your own calcuations
' Step 5:   Clear product number from worksheet PRODUCTS
' END LOOP (/submacro)


'--------------------------------------
' S T E P   O N E
'--------------------------------------

' Remove current productcodes list from worksheet PRODUCTS.
    Sheets("Products").Visible = True
    Sheets("Products").Select
    Cells.Select
    Selection.ClearContents

' Copy the entire list of productcodes over to worksheet PROCUCTS
' It is assumed the products are listed in column A.
    Sheets("Calculations").Visible = True
    Sheets("Sourcesheet").Select
    Columns("A:A").Select
    Selection.Copy

' Paste the productcodes into worksheet PRODUCTS
    Sheets("Products").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

' Remove duplicates
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes

Call Submacro

End Sub

Sub Submacro()

'--------------------------------------
' S T E P   T W O
'--------------------------------------

' Check if loop is required
    Sheets("Products").Select
If IsEmpty(Range("A2")) = False Then


' Remove existing data from worksheet CALCULATIONS
    Sheets("Calculations").Visible = True
    Sheets("Calculations").Select
    Cells.Select
    Selection.ClearContents

' Select the source sheet
    Sheets("Sourcesheet").Visible = True
    Sheets("Sourcesheet").Select

' Clear any existing filters
If ActiveSheet.AutoFilterMode Then
   ActiveSheet.AutoFilterMode = False
End If

' Add new auto filter
    Range("A1:F1").AutoFilter



'--------------------------------------
' S T E P   T H R E E
'--------------------------------------

' Apply Filter
' The macro makes the following assumptions:
'   - The source data is in columns A to F
'   - There are no blank rows in column A
'   - The column filters on column A (see Field:=1)
    RowCount = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    ProductCode = Worksheets("Products").Range("A2")
    ActiveSheet.Range("A1:F" & RowCount).AutoFilter Field:=1, Criteria1:=ProductCode

' Copy rows selected on SOURCESHEET
    ActiveSheet.Range("A2:F" & RowCount).SpecialCells(xlCellTypeVisible).Copy

' Paste selected rows on CALCULATIONS
    Sheets("Calculations").Select
    Range("A1").Select
    ActiveSheet.Paste

'  Delete Rows from sourcesheet
    Sheets("Sourcesheet").Select
    Application.DisplayAlerts = False
        ActiveSheet.Range("A2:AZ" & RowCount).SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True

' Clear any existing filters
    Sheets("Sourcesheet").Select
If ActiveSheet.AutoFilterMode Then
   ActiveSheet.AutoFilterMode = False
End If


'--------------------------------------
' S T E P   F O U R
'--------------------------------------

' Go back to CALCULATIONS
    Sheets("Calculations").Select
 
    ' FROM THIS POINT ON YOU CAN DO YOUR OWN CALCULATIONS ON THE WORKSHEET



'--------------------------------------
' S T E P   F I V E
'--------------------------------------

' Remove the product number that has just been completed from worksheet PRODUCTS
    Sheets("Products").Select
    Range("A2").Select
    Rows("2:2").Delete Shift:=xlUp



Call Submacro


End If

End Sub

Thank you, I will give it a try. I'm not sure this is the right code for me, however. I