How can I add a 1 to the most recent, repeated row in Excel? - excel

I have a dataset with 60+ thousand rows in excel and about 20 columns. The "ID column" sometimes repeats itself and I want to add a column that will return 1 only in the row that is the most recent only IF it repeats itself.
Here is the example. I have…
ID DATE ColumnX
AS1 Jan-2013 DATA
AS2 Feb-2013 DATA
AS3 Jan-2013 DATA
AS4 Dec-2013 DATA
AS2 Dec-2013 DATA
I want…
ID DATE ColumnX New Column
AS1 Jan-2013 DATA 1
AS2 Feb-2013 DATA 0
AS3 Jan-2013 DATA 1
AS4 Dec-2013 DATA 1
AS2 Dec-2013 DATA 1
I've been trying with a combination of sort and nested if's, but it depends on my data being always in the same order (so that it looks up the ID in the previous row).
Bonus points: consider my dataset if fairly large for excel, so the most efficient code that won't eat up processor would be appreciated!

An approach you could use is to point MSQuery at your table and use SQL to apply the business rules. On the positive side, this runs very quickly (a couple seconds in my tests against 64k rows). A huge minus is the query engine does not seem to support Excel tables exceeding 64k rows, but there might be ways to work around this. Regardless, I offer the solution in case it gives you some ideas.
To set up first give your data set a named range. I called it MYTABLE. Save. Next select a cell to the right of your table in row 1, and click through Data | From other sources | from Microsoft Query. Choose Excel Files* | OK, browse for your file. The Query Wiz should open, showing MYTABLE available, add all the columns. Click Cancel (really), and click Yes, you want to continue editing.
The MSQuery interface should open, click the SQL button and replace the code with the following. You will need to edit some specifics, such as the file path. (Also, note I used different column names. This was sheer paranoia on my part. The Jet engine is very finicky and I wanted to rule out conflicts with reserved words as I built this.)
SELECT
MYTABLE.ID_X,
MYTABLE.DATE_X,
MYTABLE.COLUMN_X,
IIF(MAXDATES.ID_x IS NULL,0,1) * IIF(DUPTABLE.ID_X IS NULL,0,1) AS NEW_DATA
FROM ((`C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE
LEFT OUTER JOIN (
SELECT MYTABLE1.ID_X, MAX(MYTABLE1.DATE_X) AS MAXDATE
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE1
GROUP BY MYTABLE1.ID_X
) AS MAXDATES
ON MYTABLE.ID_X = MAXDATES.ID_X
AND MYTABLE.DATE_X = MAXDATES.MAXDATE)
LEFT OUTER JOIN (
SELECT MYTABLE2.ID_X
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE2
GROUP BY MYTABLE2.ID_X
HAVING COUNT(1) > 1
) AS DUPTABLE
ON MYTABLE.ID_X = DUPTABLE.ID_X)
With the code in place MSQuery will complain the query can't be represented graphically. It's OK. The query will execute -- it might take longer than expected to run at this stage. I'm not sure why, but it should run much faster on subsequent refreshes. Once results return, File | Return data to Excel. Accept the defaults on the Import Data dialog.
That's the technique. To refresh the query against new data simply Data | Refresh. If you need to tweak the query you can get back to it though Excel via Data | Connections | Properties | Definition tab.
The code I provided returns your original data plus the NEW_DATA column, which has value 1 if the ID is duplicated and the date is the maximum date for that ID, otherwise 0. This code will not sort out ties if an ID's maximum date is on several rows. All such rows will be tagged 1.
Edit: The code is easily modified to ignore the duplication logic and show most recent row for all IDs. Simply change the last bit of the SELECT clause to read
IIF(MAXDATES.ID_x IS NULL,0,1) AS NEW_DATA
In that case, you could also remove the final LEFT JOIN with alias DUPTABLE.

Sort by ID, then by DATE (ascending). Define entries in new column to be 1 if previous row has the same ID and next row has a different ID or is empty (for last row), 0 otherwise.

It could be done in VBA. I'd be interested to know if this is possible just using formulas, I had to do something similar once before.
Sub Macro1()
Dim rowCount As Long
Sheets("Sheet1").Activate
rowCount = Cells(Rows.Count, 1).End(xlUp).Row
Columns("A:D").Select
Selection.AutoFilter
Range("D2:D" & rowCount).Select
Selection.ClearContents
Columns("A:D").Select
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1:B" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1:A" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.Apply
Dim counter As Integer
For counter = 2 To rowCount
Cells(counter, 4) = 1
If Cells(counter, 1) = Cells(counter + 1, 1) Then Cells(counter, 4) = 0
Next counter
End Sub
So you activate the sheet and get the count of rows.
Then select and autofilter the results, and clear out Column D which has the 0s or 1s. Then filter on the values mbroshi suggested that you say you're already using. Then execute a loop for each record, changing the value to 1, but then back to 0 if the value ahead of it has the same ID.
Depending on your processor I dont think this would take more than a minute or two to run. If you do find something using formulas I would be interested to see it!

Related

VBA Range.End(xlDown) stops at last visible row

I am doing a simple VBA script in Microsoft Excel which iterates a list of cars and a list of information about when the cars were refueled to provide an overview of how many kilometers each car is driving each month.
I make use of the Range.End property to calculate the number of rows with data and then loop through the indicies.
Set Data = Worksheets("Tankninger") ' Danish for refuellings
NumRows = Data.Range("A1", Data.Range("A1").End(xlDown)).Rows.Count
For x = 1 To NumRows
' Process data
Next
Everything seemed to be working fine, however I found that if someone applied a filter to e.g. the sheet with refuelling data - e.g. only showing data related to car A, then NumRows would be assigned the index of the last visible row.
Example: if the refuling sheet contains 100 records and the records related car A are located on row 50-60, then NumRows would be assigned the value 60 - resulting in my script ignoring the last 40 records.
Is there a way to make the Range.End property ignore any filter applied to sheet, or will I have to change the implementation to use a while-loop instead?
I ended up replacing the for-loop with a while-loop. This allowed me to access every cell regardless of any filtering applied to the sheets.
Set Data = Worksheets("Tankninger") ' Danish for refuellings
r = 2
While Not IsEmpty(Cars.Cells(r, 1).value)
' Process data
Wend
What you can do is add the following in your code to remove filters before you find the last row with data.
'Remove all filters
Worksheets("Sheet1").Activate
On Error Resume Next
ActiveSheet.ShowAllData

How to remove duplicates from individual powerquery columns without removing entire rows

I have a data table that records cost savings data and I have 1 row per project. This has overall project type data such as annual spend, annual savings, etc. but also has the months the savings fall into. To pivot on this data, I converted it to a table with PowerQuery but some columns repeat such as annual spend for each month where there are savings so I might get 10 rows for savings which is correct, but the annual spend is duplicated 10 times. Can I remove duplicates in just those columns retaining the other data.
I have searched and tried various solutions but haven't found one that works. I am not set on data table format, so am open to anything.
Below is a sample of the data
Sample of PowerQuery
As you will see, Baseline Spend, Negotiated Spend, Savings Amount are all shown for each row and I need to use these in a pivot/slicer.
Any help would be appreciated.
Regards,
Keith
I think one solution might be to "only keep the first1 annual spend per project". More abstractly, "only keep the first value in column(s) X per column(s)Y".
Below is some mock/dummy data. I only want to keep the highlighted values in my annual spend column (as the highlighted values are the first "annual spend" figures per "project").
This is the M code I'm using to achieve this. (To try it, open the Query Editor > Advanced Editor (near top right) > copy-paste code below to there > OK).
let
OnlyKeepFirstValueInColumn = (someTable as table, columnsToNullify as list) as table =>
let
firstRow = Table.FirstN(someTable, 1), // This assumes first row contains a non-blank value.
remainingRows = Table.Skip(someTable, 1),
loopAndNullify = List.Accumulate(columnsToNullify, remainingRows, (tableState, currentHeader) => Table.TransformColumns(tableState, {{currentHeader, each null}})),
combined = firstRow & loopAndNullify
in combined,
FirstValueOfColumnsPerGroup = (someTable as table, groupByColumns as list, columnsToNullify as list) =>
let
group = Table.Group(someTable, groupByColumns, {{"toCombine", each OnlyKeepFirstValueInColumn(_, columnsToNullify), type table}}),
combined = Table.Combine(group[toCombine])
in combined,
aggregatedTable = Table.FromColumns({Text.ToList("aaabbbccccdddeeefg"), List.Repeat({1000}, Text.Length("aaabbbccccdddeeefg"))}, type table [project=text, annual spend=number]),
transformed = FirstValueOfColumnsPerGroup(aggregatedTable, {"project"}, {"annual spend"})
in
transformed
The important bit to understand is this line:
transformed = FirstValueOfColumnsPerGroup(aggregatedTable, {"project"}, {"annual spend"})
in which you should replace:
aggregatedTable with whatever variable/expression contains your table
{"project"} with the name of your "project" column (keep the curly braces {} though as they let you pass in several columns if needed)
{"annual spend"} with the names of whichever column(s) you want to keep only the first value in (keep the curly braces {})
This is what I get (which I think is similar to what you want):
1To keep things simple, we'll say "first" here means the value in the first row. It could have meant "first non-null value" or "first value satisfying some particular condition or logic", but your data suggests the simpler definition will work okay.

Sum of a specific range that changes on each iteration of a loop

I have a sheet that the values of a range change each time I change a specific cell. Let's say that the cell C8 is an indentity of a person and column H the scheduled monthly repayments. I need to find the aggregate monthly repayments, hence on each possible value of C8 (and that actually means for every person as you can think of different values of C8) I need the aggegate of repayments, hence the aggegate of cell Hi Hence, keeping row i constant and changing cell C8, I always need to sum Hi. So I actually need sum(Hi) (i constant and the index of the sum is cell c8, so if c8 takes value from 1 to 200, I need the sum(Hi(c8)), again row i . Hi(c8) it is just a notation to show you that Hi depends on the value of c8. The actual formula in cell H10 is INDEX('Sheet2'!R:R,MATCH('Sheet1'!$C$8,'Sheet2'!F:F,0)))). H11 and onwards have the same formula with slight twists for the fact that the repayments are not always equal, but the index function remains the same.
Then, the total of H10 for all possible values of c8 is pasted in c17, the total of H11 is pasted in C18 etc. Please find some images below, maybe that helps to support what I try to achieve. enter image description here
I have the following code for that purpose. Note that the above example was just to explain you a bit the background, the cells and the range that changes are different.
sub sumloop()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Sheets("Sheet1").Range("C8").Value = 1
Dim i, k As Integer
i = 1
k = Sheets("Sheet1").Range("C9").Value
Dim LR As Long
LR = Sheets("Sheet1").Range("C" &
Sheets("Sheet1").Rows.Count).End(xlUp).row
Sheets("Sheet1").Range("C17:C" & LR).ClearContents
Do While i <= k
If (Sheets("Sheet1").Range("J9").Value = "") Then
Sheets("Sheet1").Range("h10:h200").Copy
Sheets("Sheet1").Range("c17").PasteSpecial
Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Else
Sheets("Sheet1").Range("h9:h200").Copy
Sheets("Sheet1").Range("c17").PasteSpecial
Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
Sheets("Sheet1").Range("C8").Value = Sheets("Sheet1").Range("C8").Value+1
i = i + 1
Loop
Sheets("Sheet1").Range("C8").Value = 1
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
The if inside of the loop is needed as the location of the first value of the range depends on some criteria which have not to do with the code. Also k denotes the maximum number of possible values. What I need is approximately 250.
While the code works, it takes approximately 40 seconds to run for 84 values of cell C8 and approximately 1.5 minute for 250. I tried some things, changed do while to for but nothing significant, used variable ranges instead of fixed ones like h10:h100, very similar to what I do with Sheet1.Range(C17:C&LR). Again no significant changes. As I am very new to vba I don't know if 1.5 minutes are a lot for such a simple code, but to me it seems a lot and this analysis is needed for 10 different combinations of 250 different values for cell c8, which means 15 minutes approximately.
I would appreciate if anyone can suggest me something faster.
Thank you very much in advance.
Here is a complete solution, with explainations in comments.
Because we do not have you source spreadsheet, I could not run any tests on this.
Option Explicit 'This forces you to declare all your varaibles correctly. It may seem annoying at first glance, but will quickly save you time in the future.
Sub sumloop()
Application.ScreenUpdating = False
'Application.DisplayStatusBar = False -> This is not noticely slowing down your code as soon as you do not refresh the StatusBar value for more than say 5-10 times per second.
'Save the existing Calculation Mode to restore it at the end of the Macro
Dim xlPreviousCalcMode As XlCalculation
xlPreviousCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
'Conveniently store the Sheet into a variable. You might want to do the same with your cells, for example: MyCellWhichCounts = MySheet.Range("c17")
Dim MySheet As Worksheet
MySheet = ActiveWorkbook.Sheets("Sheet1")
MySheet.Range("C8").Value2 = 1 'It is recommended to use.Value2 instead of .Value (notably in case your data type is Currency, but it is good practice to use that one all the time)
Dim LR As Long
LR = MySheet.Range("C" & MySheet.Rows.Count).End(xlUp).Row 'Be carefull with "MySheet.Rows.Count", it may go beyond your data range, for example if you modify the formatting of a cell below your "last" row.
MySheet.Range("C17:C" & LR).Value2 = vbNullString 'It is recommended to use vbNullString instead of ""; although I agree it makes it more difficult to read.
Dim i As Integer, k As Integer 'Integers are ok, just make sure you neer exceed 255
k = MySheet.Range("C9").Value2
For i = 1 To k 'Use a For whenever you can, it is easier to maintain (i.e. avoid errors and also for you to remember when you go back to it years later)
'Little extra so you can track progress of your calcs
Dim z As Integer
z = 10 'This can have any value > 0. If the value is low, you will refresh your app often but it will slow down. If the value is high, it won't affect performance but your app might freeze and/or you will not have your Statusbar updated as often as you might like. As a rule of thumb, I aim to refresh around 5 times per seconds, which is enough for the end user not to notice anything.
If i Mod z = 0 Then 'Each time i is a mutliple of z
Application.StatusBar = "Calculating i = " & i & " of " & k 'We refresh the Statusbar
DoEvents 'We prevent the Excel App to freeze and throw messages like: The application is not responding.
End If
'Set the range
Dim MyResultRange As Range
If (MySheet.Range("J9").Value2 = vbNullString) Then
MyResultRange = MySheet.Range("h10:h200")
Else
MyResultRange = MySheet.Range("h9:h200")
End If
'# Extract Result Data
MyResultRange.Calculate 'Refresh the Range values
Dim MyResultData As Variant
MyResultData = MyResultRange.Value2 'Store the values in VBA all at once
'# Extract Original Data
Dim MyOriginalRange as Range
MyOriginalRange.Calculate
MyOriginalRange = MySheet.Range("c17").Resize(MyResultRange.Rows.Count,MyResultRange.Columns.Count) 'This produces a Range of the same size as MyResultRange
Dim MyOriginalData as Variant
MyOriginalData = MyOriginalRange.Value2
'# Sum Both Data Arrays
Dim MySumData() as Variant
Redim MySumData(lbound(MyResultRange,1) to ubound(MyResultRange,1),lbound(MyResultRange,2) to ubound(MyResultRange,2))
Dim j as long
For j = lbound(MySumData,1) to ubound(MySumData,1)
MySumData(j,1)= MyResultData(j,1) + MyOriginalData(j,1)
Next j
'Instead of the "For j = a to b", you could use this, but might be slower: MySumData = Application.WorksheetFunction.MMult(Array(1, 1), Array(MyResultData, MyOriginalData))
MySheet.Range("C8").Value2 = MySheet.Range("C8").Value2 + 1
Next i
MySheet.Range("C8").Value2 = 1
Application.ScreenUpdating = True
Application.StatusBar = False 'Give back the status bar control to the Excel App
Application.Calculation = xlPreviousCalcMode 'Do not forget to restore the Calculation Mode to its previous state
End Sub
Added by OP (see comments)
Image 1 Code written in the initially question. enter image description here
Image 2 Code above enter image description here
OK, A few things.
Firstly, Dim i, k As Integer doesn't do what you think it does, you need to do: Dim i As Integer, k As Integer
Secondly don't use Integer in VBA use Long so Dim i As Long, k As Long
Third the calculations are killing you. Turn them off with Application.Calculation = xlCalculationManual at the start of your code and back on with Application.Calculation = xlCalculationAutomatic at the end of your code.
Now we are presented with really fast code but the problem that it doesn't update on each iteration which you need it to do. You can calculate just a range like so: Sheets("Sheet1").Range("h10:h200").Calculate so put that in just before you copy the range
There will be an even faster way to do this but I just can't seem to wrap my head around your requirements so I am unable to assist further.
Welcome to StackOverflow.
I must admit I got a bit confused by your narrative, as I did not fully understand if you are doing a sum(a,b,c) or a sum(sum(a,b,c), sum(d,e,f), ...).
In any cases, a trick that will dramatically accelerate your script is the use of arrays.
Performing calcs with VBA is not slow, but retrieving the data from Excel (communicating with the application) IS slow, and pretty much depending on the number of "requests", rather than the quantity of data requested.
You can use arrays to request the data from a range all at once, isntead of requesting the value of each cell separately.
Dim Arr() As Variant
Arr = Range("A1:E999")
It is as simple as this.
Give it a try and if you are still struggling let us know.
BONUS
If you are new to Arrays, keep in mind you can have a two-dimmensionnal array:
Dim 2DArray(0 to 10, 0 to 50)
Or a stacked array (an array of arrays):
Dim MyArray() as String
Dim StackedArray() as MyArray
Dim StackedArray() as Variant
You will need a 2D-Array for extracting the data from a range, but I feel you may need an Array of 2D-Arrays for your Sum of Sums.
Some recommended reading: https://excelmacromastery.com/excel-vba-array/
How to achieve the same through pivot charts (no VBA)
Step 1
First, you must organize your data in a specific way, where each column is a field, and each row is a data entry. If you are not familiar with databases, this is the most tricky point as you may arrange your data in different ways.
Long story short, we will take an example where you have 3 customers and 4 dates.
So that is 12 data entries, which will provide the repayment value for each of the possible customer ID and date.
Step 2
Select that data and insert a PivotChart.
Note: you could insert a PivotTable alone, or a PivotChart alone. I recommend the option hwere you insert both, as managing your data will be more intuitive when working on the Chart. The table is updated at the same time you update the chart.
Step 3
Make sure the all your data is selected, including the top row which will dictate the name of each field (the name of each column).
Step 4
A new sheet has just been create, and you can see where both your PivotTble and PivotCharts will appear. Select the chart.
Step 5
A menu to the right will appear (it might have already been there, so make sure you selected the Chart and not the Table, as that menu would be slightly different).
Step 6
Drag and drop the field names into the categories as shown.
What you are doing here is telling Excel what data you want to see (Values) and how you want to break it down (per date, and per customer).
Step 7
By default dates data is always groupped quartile and year. To be able to see all the date we have data for, you can click the [+] near the data on the Table: this will show more details for both the table and the chart.
Step 8
But we want to get completely rid of the quartils and years. In order to achieve this, you need to right click any value of your date column in the Table, and choose "Ungroup" as displayed.
Step 9
Your data now looks like this.
Note the time axis is not on scale. For example if you hae monthly data and a month is missing, there will be no gap. This is one of the difficulties with Pivot data. This can be overcomes, but it is off topic here.
Step 10
Now we want to have a cumulative view of the data, so we want to play with the way the values are proessed by Excel.
Select the chart, then in the right panel: right click on the "Sum of Repayment" field, and select "Value Field Settings".
Step 11
In the "Show Values As" tab, select "Show values as" "Running Tital In".
Then choose "Date".
Here we are telling Excel that the value to display should be a cumulative total, cumulated according to the "Date" field.
Press OK.
Step 12
You now have what you are looking for. If you look in the Table, you have one column per Customer ID, and one row per date. For a given Date, you have the cumulative repayment made by a given Customer ID. At the very right, you have the Grand Total, which is, for a given date, the sum of all the Customer ID values.
Step 13
The Chart keeps showing the cumulative payment per CUstomer ID, and we cannot see the grand total.
In orer to achieve this, simply remove the "Customer ID" field from the "Legend (Series)" category area in the Fields Panel, as shown. (you can untick the Customer Id [x] box, or you can drag and drop it from the category area to the main list area).
Step 14
Now we only have the Grand total in the chart. But why?
If you display the "Value Field Settings" of Sum of Repyament" (Step 10), the first tab "Summarize Values By" will tell Excel what to do when several value meet the same Legend and Axis values.
Now that we removed the Customer ID field from the Legend area, for each date, we have 3 repayment values (one for each Customer ID). In the field settings, we tell Excel to use a "Sum". So it returns the sum of the 3 values.
But you could play around and return the Average, or even use "Count", which will show you how many records you have (it will return 3).
That is why pivot charts are so powerful: with only a few clicks and/or drag and drop, you can display a myriad of different graphics for your data.
For future interest, you should look online for Filters, and "Insert Slicer" (which is equivalent to filtering, but will add button directly on your chart: great when showing the data to colleagues and switch from one setting to another)
Hope this helped!

How to merge two (or more) rows using VBA in Excel?

I am trying to merge two rows in Excel using VBA in order to create a new row with the combination values of selected rows using a factor x.
alpha 5 6 8 3 ...
beta 10 1 5 7 ...
With alpha and beta I want to create row ab70 (x=.7)
ab70 6.5 4.5 7.1 4.2 ...
(5*.7+10(1-.7)) ...
I would like to create this from a GUI in VBA selecting from a list the materials and chosing the factor x.
Thanks :D
L
The first version of this answer was more concerned with clarifying the requirement than answering the question. The second version is closer to an proper answer. Questions in the first version which were answered in comments have been deleted.
First version after removal of questions
This is not a site which can teach you to create a userform although you could get help with the code for a control. Try searching the web for “excel vba userform tutorial”. There are a number to choose from. I have not tried any so cannot make a recommendation.
A List box allows the program to provide a list from which the user can select one or more items. A Combo box allows the program to provide a list from which the user can select one item or enter a new value that is not within the list. You do not want the user to be able to specify their own material so you need a List Box. By default the user can only select one item which is what you want.
Second version
This will not be a complete answer. I will give you design ideas which you can then develop to meet your exact requirement or you can clarify your requirement and I will develop them a little more. I will give you some useful code but not all you will need for the complete solution.
You say that combining two materials would meet your immediate needs but in the longer term you wish to combine more. There are different approaches to addressing such a situation:
Design and implement a solution for the immediate need now. Redesign for the longer term later.
Design and implement a solution for the long term need now.
Design a solution for the long term then implement as much of the long-term design as seems appropriate.
None of these approaches will be correct in every case. If you are working to a deadline, approach 1 many be the only choice. Approach 1 may also be appropriate if you lack experience with the technology and wish for a simple implementation as a training exercise. When I was young, distributing a new version of an application to multiple users could be very expensive and approach 2 would often be the preferred approach. These days, approach 3 is normally my preference.
From your comments I deduce you are thinking of something like:
The two list boxes are filled with the names of the materials so the user can click one row in the first list box and one in the second to specify the two materials. Text boxes allow the user to enter the Proportion and the Name. I have used the blue “Rem” to represent the remainder (1 – x) which you may wish to display as a comment. You may not have thought of buttons. There should always be an Exit button in case the user has started the macro unintentionally. Clicking a button to save the mixture allows the user to check the four values first.
I think this could be an excellent design for the two material version. If we ignore the actual merging of the rows, there would be little code behind this form.
I do not know how long your material names are but I assume this design could be expanded for three or four materials by adding extra list boxes to the right with a Proportion text box under all but the last list. However, this arrangement would have a low maximum number of materials in a mixture. This will be acceptable if you do have a low maximum. You might also allow the user to mix mixtures thereby allowing an unlimited number of base materials in a mixture.
The code behind a form that allowed three or four materials in a mixture would be only a little more complicated than that behind the two material version.
I have two alternative designs that would perhaps be better with a higher maximum number of materials but it will not outline then unless you indicates that this first design is unacceptable.
I would expect any good tutorial to explain the various methods of loading a list box with values to I will not repeat them.
However you decide to handle the selection of materials and their proportions, you will need a routine to generate the new row.
I have created a worksheet “Material” and have set the first few rows and columns so:
I appreciate you have many more rows and columns but my data is adequate for a test and demonstration. Note in the heading line "Prop" is short for "Property".
You need to tell the routine which merges rows, which rows to mix. The user will select material B2 say. You could pass “B2” to the routine and let it discover the row from which it had come but this would make the routine more difficult to code than necessary. When loading the list boxes from this worksheet, values will be taken from column A of rows 2 to 12. I would expect your user form tutorial to explain that your code can identify the value selected by the user either by value (B2) or by index (4th row). You know the 1st row of the list box was loaded from row 2 of the worksheet so you can calculate that the 4th row of the list box was loaded from row 5 of the worksheet.
You need to tells the routine the proportions entered by the user and the name of the mixture.
Above I listed three possible approaches to deciding how much to implement. An addition to any of these approaches is the inclusion of flexibility that is not required but is as easy or is easier to include than exclude.
The declaration for my routine is:
Sub RecordNewMixture(ByVal WshtName, ByRef RowSrc() As Long, ByRef Prop() As Single, _
ByVal MaterialNameNew As String)
You will only have one worksheet holding materials and its name is unlikely to change so I could hardcode that worksheet’s name into the routine. However, it almost as easy to make the worksheet name a parameter and I think it makes the code tidier so I have make it a parameter.
The routine requires the array Prop() hold all the proportions including the last. So, for example, (0.7, 0.3) or (0.3, 0.3, 0.4). The user form will have to calculate the last proportion so it might as well pass the last proportion. I have made Prop() an array of Singles which I assume will give you adequate precision. If you do not understand the last sentence I can explain. Note that here "Prop" is short for proportion. Sorry for using "Prop" as an abbreviation for both "Property" and "Proportion". I did not notice until I the final checking of this text.
I needed a routine to test Sub RecordNewMixture so I have provided it as a demonstration. Note that I have coded and tested this routine without any involvement of the user form. It is always a good idea to develop and test your routines in isolation before combining them into the finished product.
After running the macro, worksheet “Material” has two new rows:
If you duplicate the new rows with formulae, you will find that the values are as you require.
Option Explicit
Sub Test()
Dim RowSrc() As Long
Dim Prop() As Single
ReDim RowSrc(0 To 1)
ReDim Prop(0 To 1)
RowSrc(0) = 2: Prop(0) = 0.7!
RowSrc(1) = 4: Prop(1) = 0.3!
Call RecordNewMixture("Material", RowSrc, Prop, "Join24")
ReDim RowSrc(1 To 3)
ReDim Prop(1 To 3)
RowSrc(1) = 3: Prop(1) = 0.3!
RowSrc(2) = 6: Prop(2) = 0.3!
RowSrc(3) = 9: Prop(3) = 0.4!
Call RecordNewMixture("Material", RowSrc, Prop, "Join369")
End Sub
Sub RecordNewMixture(ByVal WshtName, ByRef RowSrc() As Long, ByRef Prop() As Single, _
ByVal MaterialNameNew As String)
' * RowSrc is an array containing the numbers of the rows in worksheet WshtName
' that are to be mixed to create a new material.
' * Prop is an array containing the proportions of each source material in the new
' mixture.
' * Arrays RowSrc and Prop must have the same lower and upper bounds.
' * MaterialNameNew is the name of the mixture.
' * Each data row in Worksheet WshtName defines a material. Column A contains the
' name of the material. The remaining columns contain numeric properties of the
' material.
' Each data row in Worksheet WshtName must have the same maximum number of
' columns. Call this value ColLast.
' * This routine creates a new row below any existing rows within worksheet
' WshtName. Call this row RowNew. The values in this new row are:
' * Column A = MaterialNameNew
' * For ColCrnt = 2 to ColMax
' * Cell(RowNew, ColCrnt) = Sum of Cell(RowSrc(N), ColCrnt) * Prop(N)
' for N = LBound(RowSrc) to UBound(RowSrc)
Dim ColCrnt As Long
Dim ColLast As Long
Dim InxRowSrc As Long
Dim RowNew As Long
Dim ValueNewCrnt As Single
Application.ScreenUpdating = False
With Worksheets(WshtName)
' Locate the row before the last row with a value in column A
RowNew = .Cells(Rows.Count, "A").End(xlUp).Row + 1
' Store name of new material
.Cells(RowNew, "A") = MaterialNameNew
' Locate the last column in the first source row. Assume same
' last column for all other source rows
ColLast = .Cells(RowSrc(LBound(RowSrc)), Columns.Count).End(xlToLeft).Column
For ColCrnt = 2 To ColLast
' If Single does not give adequate precision, change the declaration of
' Prop() and ValueNewCrnt to Double. If you do this, replace "0!" by "0#"
ValueNewCrnt = 0!
For InxRowSrc = LBound(RowSrc) To UBound(RowSrc)
ValueNewCrnt = ValueNewCrnt + .Cells(RowSrc(InxRowSrc), ColCrnt).Value * Prop(InxRowSrc)
Next
.Cells(RowNew, ColCrnt) = ValueNewCrnt
Next
End With
Application.ScreenUpdating = True
End Sub

Excel: create sortable compound ID

All, I asked a question "Excel VBA: Sort, then Copy and Paste" and received two excellent answers. However, because I failed to provide sufficient user requirements, they won't work: I asked for a fix to the existing solution I created, instead of specifying the actual business need and seeing if anyone has a better way.
(sigh) Here goes:
My boss asked me to create a ss to log issues. He wants a compound ID that concatenates the "Assigned Date" with a number that indicates what number issue it is for that day only. A new day, the count must restart at 1. E.g.:
Assigned Issue Concatenated
Date & Count = ID
5/11/2011 & 1 = 5112011-1
5/11/2011 & 2 = 5112011-2
5/11/2011 & 3 = 5112011-3
5/12/2011 & 1 = 5122011-1
I solved this with a hidden column C that calculates =IF(D2<>D1,1,C1+1), thus calculating the Issue Count by incrementing the previous issue count if the assigned date in column D is the same as the previous date, and starting over at 1 when the date changes. Another column concatenates the assigned date and the issue count, and I have my issue ID.
Quick, easy, elegant, in, out, and done. Right? But when I delivered the ss, he pointed out that if you (that is, he) sorts any part of the spreadsheet, the issue ID goes out of sequence. Of course---each formula isn't referencing the previous date in sequence if the rows are sorted out of Assigned Date order.
My immediate thought, which prompted my previous question, was to first re-sort the Assigned Date order correctly, then copy and paste the value of the calculated Issue Count to lock it in, and thus preserve the concatenated ID.
The only other way I can see to do this (in VBA, natch) is to:
evaluate all the dates in the Assigned Date column
evaluate all the numbers in the Issue Count column
calculate the latest sequential Issue Count for an a new item assigned on a given Assigned Date
Assign that sequential Issue Count to the new item
It'd be nice to then place the cursor into the next cell that the user would ordinarily go to, which would be the one right adjacent to the just-entered Assigned Date; however, that isn't necessary
That would avoid the need to re-sort the physical ss. However, besides a hazy guess that this would involve VLOOKUP, I got nothing. I couldn't find anything through searching.
Can anyone help? Or suggest a place to go? Thanks!!!
Sounds like you just want to automate a Paste Special action. The following replaces the formulas in a1:a100 with their calculated values:
Set src = ActiveSheet.Range("a1:a100")
src.Copy
src.Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
I think the formula =IF(D2<>D1,1,C1+1) could be improved as this relies on dates being in order. The following will preserve the count for any order that is sorted
Assume
ColA ColB ColC
Row1 Assigned_Date Issue Count Concatenate
Row2 05/11/2011 =COUNTIF($A$1:A2,A2) =TEXT(A2,"ddmmyyyy")&"-"&B2
Row3 05/11/2011 =COUNTIF($A$1:A3,A3) =TEXT(A3,"ddmmyyyy")&"-"&B3
Row4 05/12/2011 =COUNTIF($A$1:A4,A4) =TEXT(A4,"ddmmyyyy")&"-"&B4
Row5 05/11/2011 =COUNTIF($A$1:A5,A5) =TEXT(A5,"ddmmyyyy")&"-"&B5
Essentially enter B2 and C2 formulae and drag down. You might need to swap ddmmyyyy to mmddyyyy as we use dates first rather than months :)
Also, note the locking of the first part of the range only using $ - $A$1:Ax
This works perfectly for your current question but does not work if the Issue Count is assigned in time order per date.
How about using a procedure? Just click a button to add the next entry.
I've assumed that the entries will be given today's date and that the sheet layout is:
Rows: 1 = Title / 2 = left blank / 3 = Headings of the data block
Columns: A = Date / B = Issue Count / C = Combined ID / D etc = other data
Sub AddEntry()
Dim iDayRef As Long, iNumRows As Long, n As Long
With Range("A3")
iNumRows = .CurrentRegion.Rows.Count
For n = 2 To iNumRows
If .Cells(n, 1).Value = Date Then
If .Cells(n, 2).Value > iDayRef Then iDayRef = .Cells(n, 2).Value
End If
Next
.Cells(iNumRows + 1, 1).Value = Date
.Cells(iNumRows + 1, 2).Value = iDayRef + 1
.Cells(iNumRows + 1, 3).Value = Format(Date, "mm/dd/yyyy") & " - " & iDayRef + 1
.Cells(iNumRows + 1, 4).Select
End With
End Sub
And do you really need three columns for Date, Count, and Combined ID? If you went with a
yyyy/mm/dd - xx
ID format, one column could replace all three, and you could easily sort on it.

Resources