Excel VBA - Add or Reduce Amount in cell from cell reference - vba

I'm trying to look for some VBA Code that can reduce the Quantity in stock whenever there is Item issued in Invoice. For Example if "Keyboard" and "Mouse" item issued by 2 and 3 then the number should automatically reduce in in Stock "Quantity" Column for respected item
I already search for the solution and couldn't get one. Hope you guys can help me.
Thank you in advance.

If you could add some more information about where the values are, and how your invoice event is called it would help.
Are you running this through a Form? or on a worksheet? If there are textBoxes with information, just use those when you declare your input variables below.
Anyway. This could easily be condensed, but I'm laying it out in a more informative way so you can learn the concepts behind it instead of the most concise code.
EDITED WITH REVISED CODE: After Comments with details. SEE PIC
Sub InventoryUpdate()
Dim qtyIn As Integer
Dim qtySold As Integer
Dim sheeteName As String
Dim iRow As Integer
Dim lastStockRow As Integer
Dim lastInvoiceRow As Integer
Dim tProduct As String
Dim sRow As Integer
'Declare the sheetName here once, so you don't have to replace it every time it changes
sheetName = "Sheet1"
'Determine the last rows, unless you know it already, then ignore this.
lastInvoiceRow = Sheets(sheetName).Range("B65536").End(xlUp).Row
lastStockRow = Sheets(sheetName).Range("E65536").End(xlUp).Row
'Loop through the rows of your table. Since you know the range, it's rows 4-10
For iRow = 4 To lastInvoiceRow
'Set the temp Product name as row, Column B, and the Qty Sold from Column C
tProduct = Sheets(sheetName).Cells(iRow, 2)
qtySold = Sheets(sheetName).Cells(iRow, 3)
For sRow = 4 To lastStockRow
If Sheets(sheetName).Cells(sRow, 5) = tProduct Then
qtyIn = Sheets(sheetName).Cells(sRow, 6)
Sheets(sheetName).Cells(sRow, 6) = qtyIn - qtySold
Exit For
End If
Next sRow
Next iRow
End Sub

Related

VBA Dynamic Table (ListObject)

So, after some research I miss something somewhere... First, I linked my SQL recordset to my spreadsheet so I managed to fetch 9999 rows and 16 columns starting by Cell "B21". Onto this, I created a table named "MyScreener" with this piece of code:
Sub Create_Table()
Dim Rn As Range
Set Rn = shtEquity.Range("B21").CurrentRegion
Dim tbl As ListObject
Set tbl = shtEquity.ListObjects.Add(xlSrcRange, Rn, xlYes)
With tbl
.Name = "MyScreener"
.TableStyle = "TableStyleMedium18"
End With
End Sub
Cool so now I have a new column to add to my table, I tried some pieces of code like this one for example:
Dim tbl As ListObject
Dim lrow As Integer
Dim lcol As Integer
Set tbl = shtEquity.ListObjects("MyScreener")
lrow = tbl.Range.Rows.count
lcol = tbl.Range.Columns.count
tbl.Resize tbl.Range.Resize(lrow, lcol)
This one compile but does nothing, giving lrow = 9980 and lcol = 16 which is obviously does not taking into account my last (an seventeenth) column.
Is there anyone that can just give a tip to create a table that dynamically updates itself when I fetch a new request ? Like each request, SQL send new amount of rows and as it's linked with my sspreadsheet already it would be nice that the table within the spreadhseet updates too.
Hope my explanation will be clear enough.
Thanks in advance for looking at !
I'm a little confused.
Ordinarily, if you've already added a column to the table, it will resize.
If this code is to enlarge the table to create an extra column first, then you have to add one (1) to the current column count.
So:
tbl.Resize tbl.Range.Resize(lRow, lCol + 1)
By the way, you should declare lrow and lcol as Long and not Integer.
Integer will limit your rows to 32767, and, internally, integers get converted to Longs anyway.

Using VBA DateDiff to compare multiple Dates, output the difference and then compare output against another cell

I've got a spreadsheet which is used to record multiple times/dates where services were rendered.
In the spreadsheet the columns I'm interested in comparing start at row 9, column BA-BB, BC-BD, BE-BF, BG-BH, BI-BJ, BK-BL, BM-BN, BO-BP, BQ-BR for each of the rows in minutes. I then want to add all the total differences between the dates and finally compare that total with with AF9 if populated or if that cell is blank AG9.
I want the Macro to loop through all the rows producing a total units for each row at the end of the sheet (Column BU)
The purpose of the spreadsheet is to check that the value populated in either AF or AG is in fact correct if we were to work out the difference in times and convert to units anyway.
What I've been working on so far is:
Sub CalculateDate()
Dim Result, RowNo As Long
Dim FirstDate, SecondDate As Date
Dim ws As Worksheet
Set DateCompare = ActiveWorkbook.Sheets("Master")
Set DateCompareRng = Support.Range("BA2", Support.Cells(Rows.Count, "BA").End(xlUp).Offset(0, 18))
Set DateCompareArr = DateCompareRng.Value2
RowNo = 1
Do Until DateCompare.Cells(RowNo, 1) = ""
FirstDate = DateCompare.Cells(RowNo, 1)
SecondDate = DateCompare.Cells(RowNo, 2)
DateCompareArr(FirstDate, 3) = DateDiff("m", FirstDate, SecondDate)
RowNo = RowNo + 1
Loop
End Sub
The above is my shoddy attempt at amending some logic someone else provided on the forums to a similar question. I don't want to compare specific dates I enter though as the dates will all be different throughout the cells.
I've never used this type of function before in VBA so not really sure on how to go about changing it to suit my needs. If I can manage to loop through of of the start/end times I can probably work out how to loop through additional columns and compare against another 2 columns after that.
Some sample date is:
Start 1 | Start 2
23/03/2018 12:00 | 2018-03-23 16:00 GMT
Difference = (In minutes)
Compare Difference to:
Total Units(Column AF) = 600(this is 600 minutes)
Sorry that this is such a long question. I'm just really stuck with getting started on this problem
I like your attempt, you are on the right track. Below is tested sample code, which I think will provide you with the answer you're seeking. Good luck and happy coding
Public Sub CalculateDate()
'While I don't recommend hard coding the start and end of your range
'for this example, I thought it would simplify things.
'Start of the range is the first cell, which in your example seems
'like BA9
Const RANGE_START As String = "BA9"
'End of the range is the last cell in right most column, which
'in your example was BR. I chose the 18th row, but you could
'make it whatever you need
Const RANGE_END As String = "BR18"
'Declare a worksheet variable as you've done
'And set it to the worksheet in the ActiveWorkbook as you've done
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Master")
'Declare the range that contains the values you need to sum
Dim rngToSum As Range
'And set it to the range in the WorkSheet
'In this case the range will be
'ws.Range("BA9:BR18")
Set rngToSum = ws.Range(RANGE_START & ":" & RANGE_END)
'Declare an index to be used in the for loop below
'as we loop through each column in the row the
'code is summing
Dim nDx As Integer
'Declare a range for the row to be worked on
Dim rngRow As Range
'Declare a string value that will hold the
'output range(row, cell)
Dim outStr As String
'Declare an output range variable
Dim outRng As Range
'Declare a variable to hold the summation of the
'row values you want to add together
Dim rowSum As Long
'Outter loop to loop through each of the rows in the
'defined range
For Each rngRow In rngToSum.Rows
'Initialize/Reinitialize the rowSum to 0 for each row
rowSum = 0
'Inner loop to loop throug all the columns in the range
'you want to add together
For nDx = 1 To rngToSum.Columns.Count Step 2
'NOTE--> DateDiff uses lower case N for minutes, not lower case M
'I noticed that in your sample code
rowSum = rowSum + DateDiff("n", rngRow.Value2(1, nDx), rngRow.Value2(1, nDx + 1))
Next
'Completed adding all the columns together
'Assign the outPut row, cell for the output Range
'The formula below will concatenate the
'letter A with the current row number
'For example if the current row number is 9
'outStr will equal A9
outStr = "A" & rngRow.Row
'I always use Value2 since it is faster than the
'Text or Value properties of the range object
ws.Range(outStr).Value2 = rowSum
Next
End Sub

VBA - Creating a Data Sheet from a User Form

I'm hoping that someone can help me with my issue. I've searched this site for the correct coding for my spreadsheets, but nothing seems to work.
I have two spreadsheets: I have a front facing form (Sheet1) where the user can input information. Once the user is done inputting their information, they will press a button which will transfer the data to a large data spreadsheet ("Records"). Once the data copies from Sheet1 to Records, I want Sheet1 to clear (so that the next user has a blank form to work from). Additionally, when a new user inputs information, I want that information to go on a line below the previous user's data input on Records.
I hope that this makes sense... This is the code that I'm using now, which doesn't populate anything in "Records" (I've clearly made a mess of this).
Sub BUTTON()
Dim refTable As Variant, trans As Variant
refTable = Array("c = e6", "d = e7", "e=e8", "f=e9", "g=e10")
Dim Row As Long
Row = Worksheets("Records").UsedRange.Rows.Count + 1
For Each trans In refTable
Dim Dest As String, Field As String
Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
Next
End Sub
Does anyone have any advice for coding? Please let me know!
Try this code.
The key bit is to set up the fields as per the order you want them to appear in worksheets("Records") in columns A to V.
For example, in my example e6 maps to column A, e7 to column B etc.
Sub MapInputToColumn()
Dim fields As Range, rw As Integer, col As Integer
Set fields = Union(Range("e6"), Range("e7"), Range("e8"), Range("e9"), Range("e10"))
rw = Worksheets("Records").UsedRange.Rows.Count + 1
For col = 1 To fields.Count
Worksheets("Records").Cells(rw, col) = fields(col, 1)
Next col
fields.ClearContents
End Sub

Is it possible to add cases to a Select Case based on the number of entries in a table?

I've been messing around with VBA in Excel a bit recently; and as a small project for myself, I'm trying to create a "draw names from a hat" sort of macro.
I began by generating a random number, and then choosing which entry from a Table (i.e. ListObject) would be selected using a case statement. The problem with this is that it only works of the number of Table entries is always the same.
So my question (probably a ridiculous one) is: is it possible at all to generate a dynamic 'Select Case' block, where the number of cases on the block is based on the number of entries in the Table?
Thanks.
-Sean
Edit: To clarify: what I am trying to do, exactly, is this:
I generate a random number, i, from 1 to n=10*(number of Table entries). After this, I want to display, in a cell, one of the table entries based on the random number.
Ideally, the code would work similarly to this:
if i = 1 to 10 then choose event 1
if i = 11 to 20 then choose event 2
if i = 21 to 30 then choose event 3
...
if i = (n-9) to n then choose event (n/10)
I hope this helps to clarify the goal of the code.
From our comments here is something you can use:
Sub random()
Dim used_rows As Integer
Dim random As Integer
Dim cell_array() As Integer
used_rows = Sheet1.UsedRange.Rows.Count
ReDim cell_array(used_rows)
For i = 1 To used_rows
cell_array(i - 1) = Cells(i, 1)
Next
random = Int(Rnd * (used_rows))
MsgBox cell_array(random)
End Sub
You can go ahead and change MsgBox to whatever you like, or set like Cell(1,4).Value = cell_array(random), or however you'd like to proceed. It will be based off the number of rows used. Though depending on how you implement your spreadsheet the code might have to be changed a bit.
Here's the update code from the suggestions from the comments. Also remember to use Randomize() in your form initialization or WorkBook Open functions.
Sub random()
Dim used_rows As Integer
Dim random As Integer
'Multiple ways to get the row count, this is just a simple one which will work for most implementations
used_rows = Sheet1.UsedRange.Rows.Count
random = Int(Rnd * (used_rows))
'I use the variable only for the reason that you might want to reference it later
MsgBox Cells(random, 1)
End Sub
This assumes that by "table" you mean "Table with a capital T", known in VBA as a ListObject:
Sub PickRandomTens()
Dim lo As Excel.ListObject
Dim ListRowsCount As Long
Dim RandomNumber As Long
Dim ListEvent As String
Dim Tens As Long
Set lo = ActiveSheet.ListObjects(1)
ListRowsCount = lo.DataBodyRange.Rows.Count
RandomNumber = Application.WorksheetFunction.RandBetween(10, ListRowsCount * 10)
ListEvent = lo.ListColumns("Data Column").DataBodyRange.Cells(Int(RandomNumber / 10))
MsgBox "Random number: " & RandomNumber & vbCrLf & _
"Event: " & ListEvent
End Sub

Excel Overflow Error

Here is my code :
Dim i As Integer, a As Integer, rowsInThere As Integer, rowsInI As Integer
Dim ws As Worksheet, b As Integer
Dim x As Integer, z As Integer
Dim total As Integer
Dim value As String
rowsInProjects = Sheets("Projects").UsedRange.Rows.Count
z = 3
Worksheets("Summary_Sheet (2)").Range("b5:b50").ClearContents
Worksheets("Summary_Sheet (2)").Range("c5:c50").ClearContents
Worksheets("Summary_Sheet (2)").Range("d5:d50").ClearContents
Worksheets("Summary_Sheet (2)").Range("e5:e50").ClearContents
Worksheets("Summary_Sheet (2)").Range("F5:F50").ClearContents
Worksheets("Summary_Sheet (2)").Range("G5:G50").ClearContents
Worksheets("Summary_Sheet (2)").Range("H5:H50").ClearContents
For a = 1 To rowsInProjects
value = Worksheets("Projects").Cells(a, 1).value
Worksheets("Summary_Sheet (2)").Cells(a + 4, 2).value = value
For i = 5 To Worksheets.Count
rowsInI = Worksheets(i).UsedRange.Rows.Count
For x = 1 To rowsInI
If Worksheets(i).Cells(x + 8, 3).value = value Then
total = total + Worksheets(i).Cells(x + 8, 6).value
End If
Worksheets("Summary_Sheet (2)").Cells(i, z).value = total
Next x
z = z + 1
Next i
z = 3
Next a
There error arises on the total = total + ... line. What my code is doing is copying a list of projects from a worksheet into a new one.
It then has to search through the other worksheets for each of the project names added. Each of the other worksheets will have 2-3 records with the project name. I want to get the total cost of the project from each worksheet and then insert it back into the orginal file.
Steps:
1. Create list of projects
Iterate through List
iterate through each worksheet
totaling values from matching projects
Insert value back into project list
J O'Brien, Choate and Townsend are the 3 worksheets
This is the Choate worksheet
Is this approach right for what I am trying to achieve?
you're probably overflowing the max size of an Integer, which is 32767. Try using a long for your range loop counter instead.
This would apply to a, x, z and rowsInI
You also asked if this (your method) was the right approach, Yours works so yes it is. However, it could possibly be optimised.
For every item in your project list, you're iterating over every row in your data sheet in all of your data sheets.
Which, depending on the number of rows in each sheet, is a fair few! (its at least Projects * Rows * 3)
I dont know if your "projects" list is one you generate per-run, so you only get a few projects or if its just everything you've got.
Hopefully the code below makes some sense, if you decide to give it a go please make sure you run it on a copy of your data! It's an example and it only dumps the result to the debug window.
The code below (which may not function perfectly as I might have got the columns and rows wrong) will loop over each sheet once and calculate a per-sheet total for each project (allowing for multiple instances of the same project in a single sheet, if this is possible in your data)
Sub Main()
Dim Projects As Object
'Dim Projects As Scripting.Dictionary
Set Projects = CreateObject("Scripting.Dictionary")
'Set Projects = New Scripting.Dictionary
Dim Project As String
Dim Sheets() As String
Dim Name As String
Dim Sheet As Worksheet
Dim SheetIndex As Integer
Dim ProjectColumn As Variant
Dim TotalColumn As Variant
Dim Index As Integer
Dim Max As Long
Dim MaxRow As Long
' You'll need to put your sheet names below
' not very nice, just a way to predefine an array containing sheet names
Sheets = Split("Sheet1,Sheet2,Sheet3", ",")
' loop over all the sheets
For SheetIndex = 0 To UBound(Sheets)
' get a reference to the sheet were looking at
Set Sheet = ThisWorkbook.Worksheets(Sheets(SheetIndex))
' calculate the last row in the workbook (as using UsedRange isnt always right)
MaxRow = Sheet.Cells(Sheet.Rows.Count, 3).End(xlUp).Row
' get the data were looking for
' the 9 in the next 2 lines might be wrong, it should be the row# for the first data row
Set ProjectColumn = Sheet.Range(Sheet.Cells(9, 3), Sheet.Cells(MaxRow, 3)) ' the 9 here might be wrong!
Set TotalColumn = Sheet.Range(Sheet.Cells(9, 6), Sheet.Cells(MaxRow, 6)) ' again, 9
Max = MaxRow - 8 ' adjust the max row to account for the +8 header cells above the data
For Index = 1 To Max
' loop over all the projects in the current sheet
Project = ProjectColumn(Index, 1)
' this allows for multiple instances of the same project per sheet (no idea if this occurs in your data)
If Projects.Exists(Project) Then
If Projects(Project).Exists(Sheets(SheetIndex)) Then
' update the total
Projects(Project)(Sheets(SheetIndex)) = Projects(Project)(Sheets(SheetIndex)) + TotalColumn(Index, 1)
Else
' inclue the total for the sheet
Projects(Project).Add Sheets(SheetIndex), CLng(TotalColumn(Index, 1))
End If
Else
' new project, add it and the total value for the current sheet
'Projects.Add Project, New Scripting.Dictionary
Projects.Add Project, CreateObject("Scripting.Dictionary")
Projects(Project).Add Sheets(SheetIndex), CLng(TotalColumn(Index, 1))
End If
Next Index
Set ProjectColumn = Nothing
Set TotalColumn = Nothing
Next SheetIndex
' Projects now contains a list of all projects, and the totals for your sheets.
' Projects
' - Project Name
' - - Sheet Name - Sheet Total
' dump the data to the immediate window in the vba editor
For Each Key In Projects.Keys
For Each SubKey In Projects(Key).Keys
Debug.Print Key & ", " & SubKey & " = " & Projects(Key)(SubKey)
Next SubKey
Next Key
End Sub
Using this you'd only need to iterate over each sheet once and then one further iteration over the projects sheet to extract the required totals from the result.
My normal approach is to hold all the available data in one worksheet so I can analyse it using pivot tables. If I then need to create a non-pivot table worksheet, I then use VBA to copy and PasteSpecial the pivot table as a regular range.
If there's a really good reason to hold this data in 3 separate worksheets, I would amalgamate the 3 sheets using VBA (basically copying and pasting all the data into a single worksheet with one set of column headers), adding an extra column that contains either "Choate", "OBrien" or "Townsend" during the copy/paste process, then creating a pivot table from the resulting amalgamation.
I use this approach a lot - all my data is standardised and I can filter the pivot table as required - by date, project, manager/salesperson/creator (Choate, Townsend and O'Brien), currency, or whatever.
I'm afraid this isn't strictly speaking an answer to your question, more a suggestion of a different approach. Of course, I don't know the circumstances of how you get this data, so it may not be feasible for you.