Inventory Control help....

chefdt · Nov 1, 2013

[h=2][/h] <ins style="display:inline-table;border:none;height:60px;margin:0;padding:0;position:relative;visibility:visible;width:234px;background-color:transparent"><ins id="aswift_0_anchor" style="display:block;border:none;height:60px;margin:0;padding:0;position:relative;visibility:visible;width:234px;background-color:transparent"></ins></ins>

I have a WORKBOOK named "Inventory". It consists of several WORKSHEETS that divide my food inventory into categories such as "MEAT", "DAIRY PRODUCTS", etc.

I recorded a macro that will import my inventory from an online ordering system, dump it to a WORKSHEET named "IMPORT" and normalize the data.

I want to create a macro that looks through the import data and parses it into the appropriate WORKSHEET.

Column "I" of the "IMPORT" sheet contains the name of the WORKSHEET that the data needs to be copied to.

The other worksheets will already have data in them, starting at "A8". As each item is copied to the appropriate sheet, I want to verify if the item already exists on the sheet and do one of two options.....A) If it exists, copy only "H" which is the case cost, and flag by color or bold text if the new price is different from the current B) If it doesn't exist, add the entire row of data to the bottom row of data in the appropriate sheet.

Here is a sample of "IMPORT" and "DAIRY"

Dairy Products

	A	B	C	D	E	F	G	H	I	J	K	L	M
1		Todays Date:	10/31/2013							Total:
2		Date of Last Inventory:	3/12/2010							$ -
3		Days Since Last Inventory:	1329
4		Last Person to Inventory:
5
6
7	SUPC	Item Description	Brand	Count	Package Size	Mfg #	Re-order Count	Case Cost	Case	Each	Unit Cost	Units in Stock	Total $
8	8965881	BUTTERMILK 1% LOW FAT	WHLFARM	9	.5 GAL			$ 19.05			$ 2.12		$ -
9	6697890	CHEESE AMER YEL 160 SLI	BBRLCLS	4	5 LB			$ 37.68			$ 9.42		$ -
10	2404135	CHEESE CHDR YEL MILKD SHRD FTHR	CASASOL	4	5 LB			$ 45.80			$ 11.45		$ -
11	7234958	CHEESE CUBE CHDR/COJCK/PEP JCK	BBRLIMP	3	5 #			$ 48.00			$ 16.00		$ -
12	4791386	CHEESE CUBE HAVARTI/GOUDA/MUFN	SCHRBER	3	5 LB			$ 46.74			$ 15.58		$ -

Import

	A	B	C	D	E	F	G	H	I
1	SUPC	Desc	Brand	Pack	Size	Mfr #	Par	Case $	Cat
2	DAIRY PRODUCTS
3	0671677	CHEESE BLUE CRUMBLES	SYS IMP	2	5 LB	10000847		$ 12.59	Dairy Products
4	5469259	CHEESE BRIE DOMSTC 1 KG	BBRLIMP	2	2.2 LB	10007830		$ 17.28	Dairy Products
5	2406189	CHEESE CHDR JACK SHRD FCY	CASASOL	4	5 LB	10000253		$ 47.78	Dairy Products
6	2599793	CHEESE CHDR MILD YEL PRNT	BBRLIMP	1	10 LB	10000253		$ 23.70	Dairy Products
7	6159263	CHEESE CHDR SHRP PRNT YEL	BBRLIMP	1	10 LB	10000253		$ 27.32	Dairy Products
8	2357598	CHEESE CHDR SMKD	TILAMOK	6	2 LB	10007703		$ 61.70	Dairy Products
9	2357580	CHEESE CHDR XSHRP WHITE	TILAMOK	2	5 LB	10007703		$ 53.95	Dairy Products
10	2220143	CHEESE FETA CRUMBLE DOM	SYS IMP	2	5 LB	10000847		$ 36.21	Dairy Products

Any help appreciated!

Comfy · Nov 1, 2013

Can you list all of the categories that you will use?

chefdt · Nov 1, 2013

Comfy said:
Can you list all of the categories that you will use?

Dairy Products
Meat
Seafood
Poultry
Canned And Dry
Frozen
Paper & Disp
Supp & Equip
Produce
Dispenser Bevrg
Chemical/Janitrl

One small problem also is that my worksheets are named this way, as that is how they come from the online system. I have to go in and manually change all of the "Chemical/Janitrl" to "Chemical" because I can't use the "/" character in the sheet name. I'm sure I could write the macro to filter and rename as it came into the import sheet, but if you have an easier way......Thanks

chefdt · Nov 1, 2013

Another problem I seem to have is how to keep the destination formatting. Don't know how to do that. I always have to go back in and reformat after copying.

Comfy · Nov 1, 2013

Ok try this, but please save your work first:

Code:

Sub InventoryUpdate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim CatCol As Long, SUPCcol As Long, CaseCol As Long
Dim SUPCMatch As Range


With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With


On Error Resume Next
Set ws1 = Sheets("Import")
On Error GoTo 0
If ws1 Is Nothing Then MsgBox "There is no Import Sheet": Exit Sub
ws1.Select


CatCol = ws1.Cells(1, 1).EntireRow.Find(What:="Cat", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
SUPCcol = ws1.Cells(1, 1).EntireRow.Find(What:="SUPC", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
CaseCol = ws1.Cells(1, 1).EntireRow.Find(What:="Case $", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
LastRow = ws1.Cells(ws1.Rows.Count, CatCol).End(xlUp).Row


For i = 2 To LastRow
    If ws1.Cells(i, CatCol).Value <> "" Then
        On Error Resume Next
        Set ws2 = Sheets(Replace(ws1.Cells(i, CatCol).Value, "/", ""))
        On Error GoTo 0
            If Not ws2 Is Nothing Then
                Set SUPCMatch = ws2.Columns(1).Find(What:=ws1.Cells(i, SUPCcol).Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                    If SUPCMatch Is Nothing Then
                        ws1.Range(Cells(i, 1), Cells(i, 8)).Copy
                        ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
                    Else
                        If ws1.Cells(i, CaseCol).Value <> SUPCMatch.Offset(0, 7).Value Then
                            With SUPCMatch.Offset(0, 7).Interior
                                .Pattern = xlSolid
                                .ThemeColor = xlThemeColorLight1
                                .PatternColorIndex = xlAutomatic
                            End With
                            With SUPCMatch.Offset(0, 7).Font
                                .ThemeColor = xlThemeColorDark1
                                .Bold = True
                            End With
                        End If
                    End If
            End If
    End If
ws1.Select
Next i
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
MsgBox "Import Complete"
End Sub

If there are any price differences it will change the background to black, text too white and bold so that you can't miss it

BTW you don't need to remove the "/" from the Category column, this will do that also.

chefdt · Nov 1, 2013

Comfy said:

Ok try this, but please save your work first:

Code:

Sub InventoryUpdate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim CatCol As Long, SUPCcol As Long, CaseCol As Long
Dim SUPCMatch As Range


With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With


On Error Resume Next
Set ws1 = Sheets("Import")
On Error GoTo 0
If ws1 Is Nothing Then MsgBox "There is no Import Sheet": Exit Sub
ws1.Select


CatCol = ws1.Cells(1, 1).EntireRow.Find(What:="Cat", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
SUPCcol = ws1.Cells(1, 1).EntireRow.Find(What:="SUPC", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
CaseCol = ws1.Cells(1, 1).EntireRow.Find(What:="Case $", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
LastRow = ws1.Cells(ws1.Rows.Count, CatCol).End(xlUp).Row


For i = 2 To LastRow
    If ws1.Cells(i, CatCol).Value <> "" Then
        On Error Resume Next
        Set ws2 = Sheets(Replace(ws1.Cells(i, CatCol).Value, "/", ""))
        On Error GoTo 0
            If Not ws2 Is Nothing Then
                Set SUPCMatch = ws2.Columns(1).Find(What:=ws1.Cells(i, SUPCcol).Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                    If SUPCMatch Is Nothing Then
                        ws1.Range(Cells(i, 1), Cells(i, 8)).Copy
                        ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
                    Else
                        If ws1.Cells(i, CaseCol).Value <> SUPCMatch.Offset(0, 7).Value Then
                            With SUPCMatch.Offset(0, 7).Interior
                                .Pattern = xlSolid
                                .ThemeColor = xlThemeColorLight1
                                .PatternColorIndex = xlAutomatic
                            End With
                            With SUPCMatch.Offset(0, 7).Font
                                .ThemeColor = xlThemeColorDark1
                                .Bold = True
                            End With
                        End If
                    End If
            End If
    End If
ws1.Select
Next i
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
MsgBox "Import Complete"
End Sub

If there are any price differences it will change the background to black, text too white and bold so that you can't miss it

BTW you don't need to remove the "/" from the Category column, this will do that also.

Looks like it's almost working...fantastic. Just a couple of things. The items come into the correct sheets, but keep their original formatting, and not that of the destination sheet. I also have a formula in Column K of the destination Category sheets...=IF(D10<="",IF(H10<>"",H10/D10,"")) I need to have that pasted in for each new item.

The formatting for existing items changed to WHITE on a GREY background....probably not what you had in mind.

Thanks.

chefdt · Nov 1, 2013

Hey....Sorry to bother. I figured out the formatting and formula issues, but the code to highlight the new price produces the following result.

Produce

	A	B	C	D	E	F	G	H	I	J	K
102	1740885	SALAD TABBOULEH WHEAT	BISHOP	4	3 LB	10007539		$ 37.89			$ 9.47
103	1350024	SAMPLE COOLER	PACKER	1	CS			$ 37.89			$ 37.89
104	7449309	SAMPLE COOLER #2	SAMPLE	1	CS	10007258		$ 37.89			$ 37.89

Prices changed in items of ROW 103 and 104. It kept the old price, and did not update, also only turned the background of the WHITE cell to black.

How about a macro to clear the formatting (highlighted prices) back to original.

Comfy · Nov 4, 2013

chefdt said:
Hey....Sorry to bother. I figured out the formatting and formula issues, but the code to highlight the new price produces the following result.

Produce

A B C D E F G H I J K
102 1740885 SALAD TABBOULEH WHEAT BISHOP 4 3 LB 10007539 $ 37.89 $ 9.47
103 1350024 SAMPLE COOLER PACKER 1 CS $ 37.89 $ 37.89
104 7449309 SAMPLE COOLER #2 SAMPLE 1 CS 10007258 $ 37.89 $ 37.89

<tbody>
</tbody>

Prices changed in items of ROW 103 and 104. It kept the old price, and did not update, also only turned the background of the WHITE cell to black.

How about a macro to clear the formatting (highlighted prices) back to original.

Can you post the code you are using now that you have made amendments? And what version of excel are you using?

chefdt · Nov 4, 2013

Comfy said:
Can you post the code you are using now that you have made amendments? And what version of excel are you using?

I was able to change the formatting on my own...victory for me!

I can't figure the code to paste the updated price into WS2 however. I keep getting errors!!

Here is what I tried................

If SUPCMatch Is Nothing Then
ws1.Range(Cells(i, 1), Cells(i, 8)).Copy
ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll

Else
If ws1.Cells(i, CaseCol).Value <> SUPCMatch.Offset(0, 7).Value Then
ws1.Range(Cells(i, 7), Cells(i, 7)).Copy
ws2.Range(SUPCMatch(0, 7)).PasteSpecial xlPasteValues
With SUPCMatch.Offset(0, 7).Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorLight1
.PatternColorIndex = xlAutomatic
End With
With SUPCMatch.Offset(0, 7).Font
.ThemeColor = xlThemeColorDark1
.Bold = True
End With
End If
End If

Using Excel 2010.

Thanks!

Comfy · Nov 4, 2013

Ahh I missed that out.

Rich (BB code):

If SUPCMatch Is Nothing Then
                        ws1.Range(Cells(i, 1), Cells(i, 8)).Copy
                        ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
                    Else
                        If ws1.Cells(i, CaseCol).Value <> SUPCMatch.Offset(0, 7).Value Then
                            With SUPCMatch.Offset(0, 7).Interior
                                .Pattern = xlSolid
                                .ThemeColor = xlThemeColorLight1
                                .PatternColorIndex = xlAutomatic
                            End With
                            With SUPCMatch.Offset(0, 7).Font
                                .ThemeColor = xlThemeColorDark1
                                .Bold = True
                            End With
.Value = ws1.Cells(i, CaseCol).Value
                        End If
                    End If

add that line.

Inventory Control help....

chefdt

Board Regular

Excel Facts

Comfy

Well-known Member

chefdt

Board Regular

chefdt

Board Regular

Comfy

Well-known Member

chefdt

Board Regular

chefdt

Board Regular

Comfy

Well-known Member

chefdt

Board Regular

Comfy

Well-known Member

Similar threads

Forum statistics

Share this page

Inventory Control help....

Board Regular

Excel Facts

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock