Im modifying the question that I have already posted. My requirement is very simple.
DEFECT_ID LOG_TIME STATUS
1001 08/22/2012 12:03:34 Open
1001 08/22/2012 12:03:35 Pending
1001 08/23/2012 02:13:46 Fixed
1001 08/23/2012 22:34:37 TestReady
1001 08/24/2012 12:34:43 Pending
1001 08/24/2012 19:13:39 Retest
1001 08/25/2012 22:13:40 Reopen
1001 08/26/2012 10:03:41 Retest
1001 08/27/2012 11:13:42 Closed
The above mentioned format is my 'Source' data. There will be 100s of such defects. As you can see, all the above log date and statuses belong to one single Defect_ID(1001).My actual work is I have to copy the above data into a new sheet in format that helps me to calculate the time difference between the statuses. To your attention, there are 'Eight' defect statuses: Open, Pending,Review,TestReady,Fixed,Retest,Reopen,Closed.And these defect statuses can occur more than one time in a single defect(As shown in above example, 'Pending' occurs twice. But openand closed will occur only once). Similarly there can be upto 6times a status can repeat for a Defect.So I need an output like this, where the log dates will be fitted into the corresponding statuses :
*Defect_ID* Open Pending1 Pending2...Pending6 Fixed1...Fixed6 TestReady1..Testready6 Review1..Review6 Retest1..Retest6 REopen1..REopen6 Closed
Please let me know how to post pictures. if so I can show you how exactly I need the output through VBA. Please refer my other question: 'Copying values from one column that matches a ID to a new sheet by creating new columns for eeach values through EXCEL VBA', all I need in that is, I need new columns added up for every status that is repeating. so that all my values will be into one single row.
Here is some VBA that will do what you are looking for. (If I understand the requirements correctly). It may be a bit verbose, but should be easy to maintain. There is probably a more eloquent way of doing this.
Private Sub CreateOutputSheet()
Dim iLoop, iStartRow, iEndRow As Integer
Dim iPendingCount As Integer
Dim iFixedCount As Integer
'Base Col Numbers
Const colPending As Integer = 3
Const colColFixed As Integer = 9
'.....
Dim sDefectIdCurrent As String
Dim sDefectIdPrevious As String
Dim iTargetRow As Integer
Dim sCurrentStatus As String
Dim dCurrentTime As Date
sDefectIdPrevious = Sheets("Soure").Cells(intstartRow, 1)
sDefectIdCurrent = Sheets("Soure").Cells(intstartRow, 1)
For iLoop = iStartRow To iEndRow
sDefectIdCurrent = Sheets("Soure").Cells(iLoop, 1)
'Check the current problem
If sDefectIdCurrent <> sDefectIdPrevious Then 'Reset the col counters
iPendingCount = 0
iFixedCount = 0
'....
End If
sCurrentStatus = Sheets("Soure").Cells(iLoop, 3)
dCurrentTime = Sheets("Soure").Cells(iLoop, 2)
Select Case sCurrentStatus
Case "Open"
Sheets("Target").Cells(iTargetRow, 2) = dCurrentTime
Case "Pending"
iPendingCount = iPendingCount + 1
Sheets("Target").Cells(colPending + iPendingCount, 1) = dCurrentTime
Case "Fixed"
iFixedCount = iFixedCount + 1
Sheets("Target").Cells(colColFixed + iFixedCount, 1) = dCurrentTime
'...
Case "Closed"
Sheets("Target").Cells(iTargetRow, colClosedNo) = dCurrentTime
End Select
sDefectIdCurrent = Sheets("Soure").Cells(intstartRow, 1)
Next
End Sub
Related
I'm having trouble turning my thought process into tangible code and honestly I'm not sure where to start with the code. I have a data set with two applicable columns, for the sake of simplicity we'll say A and B. A contains a list of three initials followed by a number, ex. JFD3, JFD2, JFD6, EUW1, YMG2, YMG3. Column B has a value. I need to find the range of the highest to lowest values for each set of initials, which has me thinking a max - min solution. The list of initials isn't necessarily in order, and there could be one set of initials(with a net variance of 0, which is OK), or up to 8 sets of initials, with the numbers not necessarily being consecutive. I was thinking some sort of Match(Left(3)) but i don't think that would encompass everything.
Any ideas on where to start would be much appreciated. I'll be happy to clarify if theres any questions.
You can use dictionaries from the Scripting Runtime to do this easily. Use two of them with the initials as the keys, one holding the minimum values found and the other holding the maximum values found.
Add a reference to the Microsoft Scripting Runtime (Tools->Add reference..., then check the box next to "Microsoft Scripting Runtime") or late bind (see instructions below). Something like this should do the trick, assumes initials in column 1, values in column 2, no headers:
Private Sub MinMax()
Dim mins As Dictionary
Dim maxes As Dictionary
Dim sheet As Worksheet
Set sheet = ActiveSheet
Set mins = New Dictionary
Set maxes = New Dictionary
Dim row As Long
For row = 1 To sheet.UsedRange.Rows.Count
Dim key As Variant
Dim val As Integer
key = sheet.Cells(row, 1).Value2
If Len(key) >= 3 Then
key = Left$(sheet.Cells(row, 1).Value2, 3)
val = sheet.Cells(row, 2).Value2
If Not mins.Exists(key) Then
mins.Add key, val
Else
If mins(key) > val Then mins(key) = val
End If
If Not mins.Exists(key) Then
maxes.Add key, val
Else
If maxes(key) < val Then maxes(key) = val
End If
End If
Next row
For Each key In mins.Keys
Debug.Print key & ": Min = "; mins(key) & " Max = "; maxes(key)
Next key
End Sub
To use late binding, the code is exactly the same with these exceptions. Instead of declaring mins and maxes as Dictionary, declare them as Object:
Dim mins As Object
Dim maxes As Object
And instead of setting them as New Dictionary, use CreateObject:
Set sheet = ActiveSheet
Set mins = CreateObject("Scripting.Dictionary")
Set maxes = CreateObject("Scripting.Dictionary")
Use a Pivot Table. Put your Column A field* in the Row Labels, then put column B in the Values twice. Change one from Sum to Min, and the other from Sum to Max.
* Not sure if you need to group by JFD for all JFDx or by each JFDx. If you need them grouped by the 3 initials, make a column C =left("A1",3), then use that in your
An approach to this could be:
Sort the data in the range A-B by A in alphabetical order. To do this, you can record a macro while doing this action and edit the code to make it dynamically working every time. This is required to make the below solution work, more performing for many other kinds of similar approaches.
Use While blocks to run the solution. I let you take the time to build and test a working code, but this is the idea:
startSubset = 2 '<-- we start getting the key from row 2
'build the key to define the subset
keyStart = 1
currentKey = ""
Do While Not IsNumeric(Right(Left(Range("A" & startSubset),keyStart),1))
'while the last char of the key is not numeric, let's add it to the key
currentKey = currentKey & Right(Left(Range("A" & startSubset),keyStart),1)
keyStart = keyStart + 1
Loop
After the above, the key is stored in the variable currentKey. It will be JFD if the first cell is JFD213, etc. Hence, you loop until the end of this subset storing max and min in two variables:
min = 0
max = 0
Do While Left(Range("A" & startSubset),Len(currentKey)) = currentKey
If Range("B" & startSubset) < min Then min = Range("B" & startSubset)
If Range("B" & startSubset) > max Then max = Range("B" & startSubset)
startSubset = startSubset + 1
Loop
Once this is done, you just need to cast the values into a collection, for example:
myObs.Add(currentKey)
myObs.Add(min)
myObs.Add(max) '<-- you will get something like myObs = ("DJF", 0, 100)
Then cast this object into a bigger collection:
allValues.Add(myObs) '<-- at the end you will have something like this:
'allValues = [("DJF",0,100), ("ABC", 1, 75), ...]
and re-set the values to let them continue:
currentKey = ""
keyStart = 1
All the above, should be run in a While loop that will break when the data are over.
Please note the above code cannot work standing-alone, but it's rather a possible approach to the problem that you will need to re-work on your data to make it work in real life.
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
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
I decided to start this question from scratch to clarify the question and goal.
Things to note about my data
I have a spreadsheet containing laptop product data
Each product has a Model and a SKU value
Many models have multiple SKUs associated with them
When more than 1 SKU fits into a model, there is a new row for each SKU. In this instance, each row will have the same value in the model field
Some models may have 4 batteries & 1 charger, others may have 1 battery & 2 chargers, others may have 1 battery & no charger or vice versa... what i'm trying to say is there is no set rule or relation between number of SKUs
There are two types of products, batteries & chargers
All Battery products have SKUs that begin with 'BAT'
All charger products have SKUS that begin with either 'ACA' or 'ACS'
I can easily split the two types of data to help achieve the goal - SKU, model & category data can be placed side by side in columns or in separate worksheets for each type of product (battery or charger)
Example data formatted side by side in same worksheet:
Example data in separate worksheets (sheet1 = batteries, sheet2 = chargers):
Regardless of which method is used, the model field could be positioned anywhere in column A - the model field will not be in an adjacent cell when comparing the two sets of data (as illustrated)
What I am trying to achieve
For each model, I need to have a row of data containing a battery SKU and a charger SKU
There should be a new row for the same model until all combinations are output for that model
There should be a maximum of 2 SKUs in the output for each row. This should always contain 1 battery and 1 charger
Desired Output
It is worth mentioning that this is a very small sample of the data I will be working with, full data set is more than 60k rows and growing so the solution would need to be efficient.
I'm using excel 2007.
I am a complete noob with VBA, I have purchased some plug ins to try and achieve my goal, I have spent 2 days researching and trying various methods to do this but all to no avail.
I thought that I had got close with this answer from Santosh:
https://stackoverflow.com/a/19780188/1018153
Which is what I based my previous question on, but as well as that producing duplicates and matching data between models, I couldn't actually format my data in it's complete form for that script to work for me anyway, so my original question was irrelevant.
The below statement should still work, but I wrote code to try to explain how it would work
Option Explicit 'This ensures typos in variable names are flagged
Sub MakeList()
Dim BatteryList As Range
Dim ChargerList As Range
Dim CurrentModel As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim resultrange As String
'look at the lists - note I am not looking at the type - I'm going to assume
'that we can set the address correctly
'use End(xLdown) to find the last cell - that way we don't need to
'remember to change it when the number of items changes
Set BatteryList = Worksheets("Sheet1").Range("A2", Range("sheet1!B1").End(xlDown))
Set ChargerList = Worksheets("Sheet2").Range("A2", Range("Sheet2!B1").End(xlDown))
'note the use of the Sheet2! and sheet1! in the .End(xlDown) - this is required
'even though we have the Worksheets(" to set the range
i = 2 ' result row
For j = 1 To BatteryList.Rows.Count ' look at each battery row
CurrentModel = BatteryList(j, 1)
For k = 1 To ChargerList.Rows.Count 'then look at each charger row
If ChargerList(k, 1) = CurrentModel Then
'and only write a row if the battery and charger models match
Worksheets("Sheet3").Cells(i, 1) = CurrentModel
Worksheets("Sheet3").Cells(i, 2) = BatteryList(j, 2)
Worksheets("Sheet3").Cells(i, 3) = ChargerList(k, 2)
i = i + 1
End If
Next k
Next j
End Sub
PreviousAnswer
Looking at the code in the question you pointed to, you would need to store the current model, and only add in the possibilities when the model matches. This will result in lots of #N/A! 's when the data is written out, but that should be a minor fix.
at this line:
Do While j <= UBound(c1)
I would insert the code to hold the current model
Dim OnlyThisModel as string
Do While j <= UBound(c1)
OnlyThisModel=c1(j,1)
and in this area
Do While m <= UBound(c4)
out(n, 1) = c1(j, 1)
out(n, 2) = c2(k, 1)
out(n, 3) = c3(l, 1)
out(n, 4) = c4(m, 1)
n = n + 1
m = m + 1
Loop
Check that the model is correct, and don't write if not:
Do While m <= UBound(c4)
if c1(j,1)=OnlyThisModel then
'Only write out data if model matches
out(n, 1) = c1(j, 1)
out(n, 2) = c2(k, 1)
out(n, 3) = c3(l, 1)
out(n, 4) = c4(m, 1)
n = n + 1
end if
'go to next record, regardless of if a combination was written
m = m + 1
Loop
I want a create a macro that filters,deletes & sorts values.
Let there be 4 columns:
Serial No
Data
Amount
ID (Numeric)
The macro should
delete all rows having amount=0.
Reassign serial no because now there are fewer rows than before.
Sort the data according to ID
Unable to proceed with creation. Help will be greatly appreciated!
This seems to be a basic question, and it does not seem to need a universal solution, but rather 2 loops and then as sort call... Try looping (for or while) over the records to delete rows such as:
Sub macro1()
ColumnWithSerial = 1
ColumnWithID = 4
ColumnWithAmounts = 3
'loop over column with IDs
Dim i As Long, tempID As Long
i = 3 'variable to loop = set to 1st row with data (after header)
tempID = 1 'variable to update IDs
Do While Len(Sheets("Sheet1").Cells(i, ColumnWithID).Value) > 0
Sheets("Sheet1").Cells(i, ColumnWithSerial).Value = tempID
If Sheets("Sheet1").Cells(i, ColumnWithAmounts).Value = 0 Then
Sheets("Sheet1").Cells(i, ColumnWithAmounts).EntireRow.Delete
Else
tempID = tempID + 1
End If
i = i + 1
Loop
'now call sort method (easy to record and then adapt) (make sure to use sort and not filter)
End Sub
This should generally do the job, unless there is some parameter that needs specifying...