I am making a project for my small restaurant in excel VBA, I have designed a receipt and transfer form to sell to customers or transfer items to another department (departments: Store, Kitchen and Sales Point). I have a worksheet "Inventory" which contains all items from all departments their prices and available quantities.
However, I am having trouble with updating the available quantities automatically when the "close and save" or "Print" button is clicked i.e when items are sold or transferred.
Here is the code I have tried.
Sub updateinventory()
Dim invlastrow, reclastrow As Long
Dim ws1, ws2 As Worksheet
Dim itemName, itemQty, a, b
Set ws1 = ThisWorkbook.Worksheets("Inventory")
Set ws2 = ThisWorkbook.Worksheets("Receipt")
invlastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
reclastrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox Cells(reclastrow, 3).Value
Do While Cells(invlastrow, 3).Value <> ""
itemName = Cells(invlastrow, 3).Value
For b = 19 To reclastrow
If itemName = Cells(reclastrow, 1) Then
MsgBox (itemName)
itemQty = Cells(invlastrow, 8).Value
itemQty = itemQty - Cells(reclastrow, 3)
End If
Next b
'MsgBox (itemQty)
End If
Next a
End Sub
Related
I Have practically no experience in VBA, but I need some help getting the following.
I have a Table that with a Click(), should have a line added, with the Selected Slicer values.
There are 5 Slicers on my worksheet, and I would need to return all 5 selections. (If a slicer is not selected, a msgbox should say "Select Slicers".
Please take into account this is the slicer of a table, not PivotTable
At the moment I have the following :
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'Modified 1-16-18 1:45 AM EST
Dim i As Long
Dim Lastrow As Long
Dim Project As String
Dim Werkpost As String
Dim Team As String
Dim SlicerV
Lastrow = Sheets("Facade-Materiaal").Cells(Rows.Count, "A").End(xlUp).Row + 1
Project = "VALUE OF SLICER Slicer_Project11"
Werkpost = "VALUE OF SLICER Slicer_Project12"
Team = "VALUE OF SLICER Slicer_Project13"
Zone = "VALUE OF SLICER Slicer_Project14"
LS = "VALUE OF SLICER Slicer_Project15"
With Sheets("Facade-Materiaal")
.Cells(Lastrow, 1).Value = Project
.Cells(Lastrow, 2).Value = Werkpost
.Cells(Lastrow, 3).Value = Team
.Cells(Lastrow, 4).Value = Zone
.Cells(Lastrow, 5).Value = LS
End With
Application.ScreenUpdating = True
End Sub
I cannot seem to be able to full up the values between brackets, Any help ?
Robbe
screenshot-fetching week 1 salaryI have written VBA code in excel to fetch driver weekly data in single master payment sheet. I use Driver ID has primary key to to fetch driver data. There are total 4 weeks reports MCMSSummaryReport(Week1), MCMSSummaryReport(Week2), MCMSSummaryReport(Week3),MCMSSummaryReport(Week4).
I am trying to fetch data in sheet "Monthly Payment Master2" by comparing driver ID. "Monthly Payment Master2" has list of driver id. I compare Monthly Payment Master2's driver id with other 4 weekly reports.
however when code does not find same id in weekly report which is present in Monthly Payment Master2 table it should return "" (blank) in column 'Week1'. It returns the blank where Ids does not match but after that loop skip a row and fetch data from 1+1 row.
unable to fix this issue in the code.
Below is the excel macro enable sheet link : https://drive.google.com/open?id=1aaidUeED7rkXaw-rMHoMK-4TNzkUJlN4
below is the code :
Private Sub CommandButton1_Click()
Dim salary As String, fromdate As String
Dim lastcoluns As Long, lastrow As Long, erow As Long, ecol As Long, lastrow1 As Long
lastcoluns = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
lastrow1 = Sheet7.Cells(Rows.Count, 1).End(xlUp).Row + 1
MsgBox (lastrow1)
Dim i As Integer
i = 2
Do While i < lastrow1
temp1 = Worksheets("Monthly Payment Master2").Cells(i, 1)
For j = 2 To lastrow + 1
temp2 = Worksheets("MCMSSummaryReport(week 1)").Cells(j, 1)
If temp1 = temp2 Then
salary = Sheet1.Cells(i, 18).Value
Worksheets("Monthly Payment Master2").Cells(i, 7) = salary
Else
End If
Next j
i = i + 1
Loop
MsgBox ("Week-1 data submitted successfully, Please submit Week-2 Data.")
Application.CutCopyMode = False
Sheet6.Columns().AutoFit
Range("A1").Select
End Sub
I would suggest changing the architecture of your loop to make it easier to read and more robust:
Dim salary As String
Dim wsMaster As Worksheet, wsReport As Worksheet
Set wsMaster = ThisWorkbook.Worksheets("Monthly Payment Master2")
Set wsReport = ThisWorkbook.Worksheets("MCMSSummaryReport(week 1)")
lastrow1 = wsMaster.Cells(Rows.Count, 1).End(xlUp).Row
lastrow2 = wsReport.Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
Dim foundRange As Range
Dim temp1 As String
For i = 2 To lastrow
temp1 = wsMaster.Cells(i, 1).Value2
Set foundRange = wsReport.Range("A2:A" & lastrow2).Find(temp1, LookAt:=xlWhole, MatchCase:=True)
If foundRange Is Nothing Then
salary = vbNullString
Else
salary = foundRange.Offset(0, 17).Value2
End If
wsMaster.Cells(i, 7) = salary
Next i
Please note that you aren't using lastcoluns, fromdate, ecol and erow. Also you should refer to your worksheets consistently, either use Sheet1 or Worksheets("Name"), but don't use both for the same worksheet since it's confusing to other readers.
I am trying to transfer stock transactions from a transaction workbook to another book that has the formatting i want. I want to be able to change the client name and stock at the top of the code so it makes it easier to run for multiple people. the problem is that when i run this it only returns one date in my formatted worksheet when i can see that there are 3 stock trades for the given ticker with different dates in the transaction book. it seems like the FOR function isn't looping through all the rows in the transaction book but im not sure why
Sub SortTransactionData()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Allen Smith Transactions.xlsx")
Set ws = wb.Sheets("Sheet1")
Dim wb1 As Workbook
Dim ws1 As Worksheet
Set wb1 = Workbooks("Allen Smith HI.xlsm")
Set ws1 = wb1.Sheets("MO")
Dim ticker As String
ticker = ws1.Range("A2")
Dim a As Integer
a = ws.Cells(Rows.Count, 6).End(xlUp).Row
Dim b As Integer
b = Application.WorksheetFunction.CountIf(ws1.Range("B1:B7"), "*")
For i = 2 To a
'copy date for stock transaction'
If ws.Cells(i, 6).Value = ticker Then
ws1.Cells(b + 1, 2).Value = ws.Cells(i, 1)
End If
Next
End Sub
As mentioned in comments, the problem is that cell ws1.Cells(b + 1, 2) never changes, so you keep overwriting old values as you go through your loop
Change your code to increment the index, b, each time through the loop:
For i = 2 To a
'copy date for stock transaction'
If ws.Cells(i, 6).Value = ticker Then
ws1.Cells(b + 1, 2).Value = ws.Cells(i, 1)
b = b + 1
End If
Next i
I have a master price worksheet (Test Price) with product name (col A) and price (col B). I want to create a macro that when you click a button it will update the prices through the entire workbook. The previous person in my position already created a MOD that will update prices throughout the WB if it is changed in one WS. I am trying to link the master list to that code. So loop through the list and update one sheet which will use the existing mod to update all other sheets. Can anyone please help with this?
This is the code that updates the sheets, I need to link the master price list to this:
Sub ChangePrice(row As String, price As String)
Dim cropVal As String: cropVal = Cells(row, 2).Value ' inefficient
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets
'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then
LastRow = ws.Range("A" & Rows.count).End(xlUp).row
' starts in row 12, though data starts in 13
For i = 12 To LastRow
'check column 2 if crop is the same
If ws.Cells(i, 2).Value = cropVal Then
'if so, change its price in column 10
ws.Cells(i, 10).Value = price
'this handles situations where the symbol is attached
ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then
ws.Cells(i, 10).Value = price
End If
Next i
End If
Next ws
End Sub
You could create a dictionary of the values and then pass the dictionary to the module. You would need to add a For Each loop to your master sheet to find the row with the product for each specific worksheet.
Sub CropValFind()
Dim ProdCol As Range, Cell As Range, PriceCol As Range
Set ProdCol = 'Your product column range here
Set PriceCol = 'Your Price Column range here
For Each Cell in ProdCol
Call ChangePrice(Cell.Value, CreateDictFromColumns("MasterSheetName", ProdCol.Column, PriceCol.Column))
Next
End Sub
Assuming your product and price columns are adjacent to each other and the values are strings:
Pulled from https://stackoverflow.com/a/33523909/10462532
Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Dictionary
Set CreateDictFromColumns = New Dictionary
Dim rng As Range: Set rng = Sheets(sheet).Range(keyCol & ":" & valCol)
Dim i As Long
Dim lastCol As Long '// for non-adjacent ("A:ZZ")
lastCol = rng.Columns.Count
For i = 1 To rng.Rows.Count
If (rng(i, 1).Value = "") Then Exit Function
CreateDictFromColumns.Add rng(i, 1).Value, rng(i, lastCol).Value
Next
End Function
Then your ChangePrice Sub would look something like this.
Sub ChangePrice(row As String, price As Dictionary)
Dim cropVal As String: cropVal = row
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets
'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then
LastRow = ws.Range("A" & Rows.count).End(xlUp).row
' starts in row 12, though data starts in 13
For i = 12 To LastRow
'check column 2 if crop is the same
If ws.Cells(i, 2).Value = cropVal Then
'if so, change its price in column 10
ws.Cells(i, 10).Value = price(row)
'this handles situations where the symbol is attached
ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then
ws.Cells(i, 10).Value = price(row)
End If
Next i
End If
Next ws
End Sub
A great resource to learn the in's and outs of dictionaries can be found here.
I have a table in Excel (Table1) that has these column headings: employee name, state licensed, and license status. A sample of the table would be:
John Adams NY Active
John Adams PA Active
John Adams NJ Inactive
Ralph Ames MS Active
Ed Turner MS Pending
I want to set up a summary tab that has one row per employee with a column for active licenses, pending licenses, and inactive licenses, and those cells would display a comma-separated list of the appropriate state codes. For example:
Name Active Pending Inactive
John Adams NY, PA NJ
Ralph Ames MS
Ed Turner MS
I'm just curious about the best way to get to this custom list. I wrote the function below which seems to work fine, and it runs faster than I expected, but it just seems inefficient because it loops through the entire table every time, and I've pasted formulas referencing this function to a few hundred cells:
Function comma_state_list(the_name As String, the_status As String) As String
Dim ws As Worksheet
Dim oLo As ListObject
Dim oCol As ListColumns
Set ws = Worksheets("State Licenses")
Set oLo = ws.ListObjects("Table1")
Set oCol = oLo.ListColumns
For i = 1 To oLo.ListRows.Count
If oLo.Range(i, 1).Value = the_name And oLo.Range(i, 3) = the_status Then
comma_state_list = comma_state_list & oLo.Range(i, 4) & ", "
End If
Next i
If Len(comma_state_list) = 0 Then
comma_state_list = ""
Else
comma_state_list = Left(comma_state_list, Len(comma_state_list) - 2)
End If
End Function
Is there a way to maybe use VBA to run a SQL-like query against the table so I'm just looping through the SQL result instead of the entire table every time? I was thinking this would help to alphabetize the summary list too. Or maybe there's some other better way I'm not thinking of.
OK, so here is an example using Scripting Dictionaries.
I have this table on one worksheet:
And the output should produce a new worksheet with summary data like:
I tried to document it pretty thoroughly but let me know if you have any questions about it.
Option Explicit
Sub Test()
Dim wsCurr As Worksheet: Set wsCurr = ActiveSheet
Dim wsNew As Worksheet 'output container'
Dim rowNum As Long 'row number for output'
'Scripting dictionaries:'
Dim inactiveDict As Object
Dim activeDict As Object
Dim key As Variant
'Table variables'
Dim rng As Range 'table of data'
Dim r As Long 'row iterator for the table range.'
'information about each employee/row'
Dim empName As String
Dim state As String
Dim status As String
'Create our dictionaries:'
Set activeDict = Nothing
Set inactiveDict = Nothing
Set activeDict = CreateObject("Scripting.Dictionary")
Set inactiveDict = CreateObject("Scripting.Dictionary")
Set rng = Range("A1:C6") 'better to set this dynamically, this is just an example'
For r = 2 To rng.Rows.Count
empName = rng(r, 1).Value
state = rng(r, 2).Value
status = rng(r, 3).Value
Select Case UCase(status)
Case "ACTIVE"
AddItemToDict activeDict, empName, state
Case "INACTIVE"
AddItemToDict inactiveDict, empName, state
End Select
Next
'Add a new worksheet with summary data'
Set wsNew = Sheets.Add(After:=wsCurr)
With wsNew
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Active"
.Cells(1, 3).Value = "Inactive"
rowNum = 2
'Create the initial table with Active licenses'
For Each key In activeDict
.Cells(rowNum, 1).Value = key
.Cells(rowNum, 2).Value = activeDict(key)
rowNum = rowNum + 1
Next
'Now, go over this list with inactive licenses'
For Each key In inactiveDict
If activeDict.Exists(key) Then
rowNum = Application.Match(key, .Range("A:A"), False)
Else:
rowNum = Application.WorksheetFunction.CountA(wsNew.Range("A:A")) + 1
.Cells(rowNum, 1).Value = key
End If
.Cells(rowNum, 3).Value = inactiveDict(key)
Next
End With
'Cleanup:
Set activeDict = Nothing
Set inactiveDict = Nothing
End Sub
Sub AddItemToDict(dict As Object, empName As String, state As String)
'since we will use the same methods on both dictionary objects, '
' it would be best to subroutine this action:'
Dim key As Variant
'check to see if this employee already exists'
If UBound(dict.Keys) = -1 Then
dict.Add empName, state
Else:
If Not dict.Exists(empName) Then
'If IsError(Application.Match(empName, dictKeys, False)) Then
'employee doesn't exist, so add to the dict'
dict.Add empName, state
Else:
'employee does exist, so update the list:'
'concatenate the state list'
state = dict(empName) & ", " & state
'remove the dictionary entry'
dict.Remove empName
'add the updated dictionary entry'
dict.Add empName, state
End If
End If
End Sub