Created
March 5, 2017 13:26
-
-
Save malikid/76b3061a96773cd3ac49fc27d51890c3 to your computer and use it in GitHub Desktop.
A stock maintenance macro I coded for a friend in vba.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Const NOT_FOUND = -1 | |
Sub Auto_Open() | |
Call StockMaintenance | |
End Sub | |
Sub StockMaintenance() | |
Const PRODUCTS_INTERVAL_ROWS = 19 | |
Const STOCK_RELATIVE_ROW = 11 | |
Const PRODUCTION_NAME_COLUMN = 2 | |
Const PRODUCTION_INVENTORY_ROW = 18 | |
Const ORIGIN_FILE_PATH = "D:\Work\產品進銷存狀況記錄表.xls" | |
Let yearMonthToday = Format(Now, "yyyymm") | |
Let RowIndex = 5 | |
Let columnIndex = 6 | |
Set objExcel = CreateObject("Excel.Application") | |
Set objWorkbook = objExcel.Workbooks.Open(ORIGIN_FILE_PATH) | |
' Set date to today | |
ActiveSheet.Cells(3, 46).Value = Format(Now, "ddddd") | |
' Get someone's data only | |
objExcel.Cells(1, 2).Value = "路人甲" | |
''''''''''''''''''''''''''''''''''''''''''''' | |
' Find the row CapFruit is on in original workbook | |
''''''''''''''''''''''''''''''''''''''''''''' | |
Do Until objExcel.Cells(RowIndex, 1).Value = "廠商乙" | |
RowIndex = RowIndex + 1 | |
Loop | |
''''''''''''''''''''''''''''''''''''''''''''' | |
' Find the column the stock number of this month is at in original workbook | |
''''''''''''''''''''''''''''''''''''''''''''' | |
Do Until objExcel.Cells(4, columnIndex).Value = yearMonthToday | |
columnIndex = columnIndex + 1 | |
Loop | |
''''''''''''''''''''''''''''''''''''''''''''' | |
' Copy values from original workbook to the active one | |
''''''''''''''''''''''''''''''''''''''''''''' | |
Do | |
productName = objExcel.Cells(RowIndex, PRODUCTION_NAME_COLUMN) | |
Let rowIndexOfProduct = FindRowInProducts(productName) | |
If rowIndexOfProduct = NOT_FOUND Then | |
Let rowIndexOfNewProduct = FindRowInNewProducts(productName) | |
If rowIndexOfNewProduct = NOT_FOUND Then | |
MsgBox (productName & " is not found in the sheet!") | |
' Continue Do | |
Else | |
' MsgBox (productName & " is found in new product area on row " & rowIndexOfNewProduct) | |
Set stockCell = ActiveSheet.Cells(rowIndexOfNewProduct, 51) | |
stockCell.Select | |
stockCell.Value = objExcel.Cells(RowIndex + STOCK_RELATIVE_ROW, columnIndex).Value | |
CheckInventory objExcel, productName, RowIndex + PRODUCTION_INVENTORY_ROW, columnIndex | |
End If | |
Else | |
' MsgBox (productName & " is found on row " & rowIndexOfProduct) | |
Set stockCell = ActiveSheet.Cells(rowIndexOfProduct, 46) | |
stockCell.Select | |
stockCell.Value = objExcel.Cells(RowIndex + STOCK_RELATIVE_ROW, columnIndex).Value | |
CheckInventory objExcel, productName, RowIndex + PRODUCTION_INVENTORY_ROW, columnIndex | |
End If | |
RowIndex = RowIndex + PRODUCTS_INTERVAL_ROWS | |
Loop Until objExcel.Cells(RowIndex, PRODUCTION_NAME_COLUMN).Value = "" | |
objExcel.Quit | |
End Sub | |
Private Function FindRowInProducts(productName) | |
Let RowIndex = 7 | |
Do Until ActiveSheet.Cells(RowIndex, 3).Value = productName | |
If ActiveSheet.Cells(RowIndex, 1).Value = "總庫存 (kg)" Then | |
FindRowInProducts = NOT_FOUND | |
Exit Function | |
End If | |
RowIndex = RowIndex + 1 | |
Loop | |
FindRowInProducts = RowIndex | |
End Function | |
Private Function FindRowInNewProducts(productName) | |
Let RowIndex = 7 | |
Do Until ActiveSheet.Cells(RowIndex, 50).Value = productName | |
If ActiveSheet.Cells(RowIndex, 49).Value = "Total" Then | |
FindRowInNewProducts = NOT_FOUND | |
Exit Function | |
End If | |
RowIndex = RowIndex + 1 | |
Loop | |
FindRowInNewProducts = RowIndex | |
End Function | |
Private Function CheckInventory(objExcel, productName, row, column) | |
daysInInventory = objExcel.Cells(row, column) | |
If daysInInventory < 90 Then | |
ActiveCell.Interior.ColorIndex = 3 | |
Else | |
ActiveCell.Interior.ColorIndex = 0 | |
End If | |
' Cell background color 3 => red, 0 => transparent? | |
' Reference: https://msdn.microsoft.com/en-us/library/cc296089(v=office.12).aspx | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment