I have two columns with data as double.
I'd like to create a vba script that does this:
Create a temporary third column that stores a lower value of each row.
Output min and max of the third column.
Now the problem is not to create this third column, I'd like this operation to be done in memory.
Please help
Thanks
This will show a message box with minimum and a message box with maximum value, assuming the two columns are A and B.
Sub MinMax()
' Count the number of rows in the first column
' Assuming that number of rows in second column equals those in the first column
HowFar = WorksheetFunction.CountA(Range("A:A"))
' Declare an array to store the minimums
Dim Arr() As Double
ReDim Arr(HowFar - 2)
Dim Index As Integer
Index = 0
' Loop through the first and second columns and store the minimums for each row in the array
Dim i As Integer
For i = 2 To HowFar
Minimum = Application.WorksheetFunction.Min(Range("A" & i & ":B" & i))
Arr(Index) = Minimum
Index = Index + 1
Next i
' Get the minimum value in the array
Min = Application.WorksheetFunction.Min(Arr)
' Get the maximum value in the array
Max = Application.WorksheetFunction.Max(Arr)
' MsgBox the two values
MsgBox ("Minimum = " & Min)
MsgBox ("Maximum = " & Max)
End Sub
Related
I have a dynamic table range of certain values (amounts). These amounts are generated into the table through a macro I've created.
What I want to do: Rank these amounts into the empty column by number.
eg. the cell in Column G next to 89k would be ranked as 1, one next to 77k would be 2 etc.
I also already have other functions defined, which I'm not going to explain here for readability reasons, but all you need to know: there are two variables obtained through functions
tbl_first = (int) Index of the ListRow of the first table item (so in this case it would be the row with 89k = 1st row so in this example 1)
tbl_last = (int) same as above, but indexes the last row (77k) in this example as 7
so my code is the following
' sets the tbl variable to the red table in the picture
Dim tbl As ListObject: Set tbl = Sheets("Summary").ListObjects("time_top")
Dim pos As Integer, diff as integer
diff = tbl_last - tbl_first
For j = tbl_first To tbl_last ' loops through all the added rows
For n = 1 to diff' indexing for the large function
' index the pos through the excel large function for our values (should return the k-th position from the largest value)
pos = Application.WorksheetFunction.Large(Range(Cells(tbl_first, 6), Cells(tbl_last, 6)), n)
With tbl.ListRows(1)
.Range(j, 6) = pos ' add the value to the column G to the right
End With
Next n
Next j
So the expected result would look like this:
I also keep getting the following error, which is caused by me incorrectly assigning the pos value.
Either way, probably multiple of things wrong here and much more elegant solution is out there, that just didn't hit me yet.
Think you need Rank (watch out for equal ranks). Large returns the nth largest value of a set.
Here is a simple example on a two column table which perhaps you can adapt. The rank is added in the second column.
Sub xx()
Dim tbl As ListObject: Set tbl = Sheets("Summary").ListObjects("time_top")
Dim r As Range
For Each r In tbl.ListColumns(1).DataBodyRange
r.Offset(, 1) = WorksheetFunction.Rank(r, tbl.ListColumns(1).DataBodyRange)
Next r
End Sub
I have been trying to figure this problem out for a while but I cannot think of an answer. Some context here: I have two worksheets. In sheet one, I have a column that is full of names. In the second sheet, I have an outline that has 10 rows that display the names. However, if in sheet one there are 11 names, the 11th name would not appear in sheet two because there are only 10 rows. What I need to figure out is how to insert a row for the 11th names (or nth depending on how many names are added). Once I add the nth row, I would auto fill the formula down which is the easy part. The part I cannot figure out is how to insert the row.
What I was thinking was inserting a COUNT function that would count the different names and insert the rows that way. But is there a way I could do it so there would not be a random number (the number being the COUNT) in a cell in one of my worksheets?
From my understanding, you want to insert n-10 number of rows with n being total number of rows of names.
Try this
Sub test()
Dim startr, endr As Range
Set startr = Range("A7") 'Set this to be the first row of your list of names
If Not startr.Value = "" Then
With Sheets("Sheet1")
Do Until startr.Offset(i).Value = ""
i = i + 1
Loop
End With
Set endr = startr.Offset(i - 1) 'endr is now the last row of the names
totalr = Range(startr, endr).Rows.Count 'totalr is the total number of rows/names
If totalr > 10 Then
addr = totalr - 10 'addr is the number of rows you need to add
MsgBox "You need to insert " & addr & " more rows."
'The following finds the last row of column A and inserts addr number of rows
Dim lastr As Range
Set lastr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)
lastr.Offset(1).EntireRow.Resize(addr).Insert
Else
MsgBox "Number of rows/names is " & totalr & " which is less than 10, so no rows are being added."
End If
Else
MsgBox startr.Address(0, 0) & " is empty."
End If
End Sub
I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.
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 am using VLookup function which looks up multiple values which are present in the column. This works very well but just takes a lot of time as I have 100,000 rows in the Excel sheet.
Is there any way to quicken this code?
The code basically looks up a particular value in a column and gets the offset. The difference between simple VLookup and this is that in case there are multiple rows with the same lookup value then it gets all the elements.
Function VLookupAll(ByVal lookup_value As String, _
ByVal lookup_column As Range, _
ByVal return_value_column As Long, _
Optional seperator As String = ", ") As String
Dim i As Long
Dim result As String
For i = 1 To lookup_column.Rows.Count
If Len(lookup_column(i, 1).Text) <> 0 Then
If lookup_column(i, 1).Text = lookup_value Then
result = result & (lookup_column(i).Offset(0, return_value_column).Text & seperator)
End If
End If
Next
If Len(result) <> 0 Then
result = Left(result, Len(result) - Len(seperator))
End If
VLookupAll = result
End Function
This is about 20-30x faster than a simple loop (tested over a column of 20k values, with 3 matches to the value being searched).
'rng: a single-column range to search for matches
'val: the value to match on
'col: offset from match in rng to concatenate values from (similar
' to the matching VLOOKUP argument)
Function MultiLookup(rng As Range, val As String, col As Long)
Dim i As Long, v, s
Dim r As Long
r = rng.Cells.Count
v = Application.Match(val, rng, 0)
s = ""
Do While Not IsError(v)
s = s & IIf(s <> "", ",", "") & rng.Cells(v).Offset(0, col - 1).Value
r = r - v
Set rng = rng.Offset(v, 0).Resize(r, 1)
v = Application.Match(val, rng, 0)
Loop
MultiLookup = s
End Function
http://www.excelhero.com/blog/2011/03/the-imposing-index.html says "Excel INDEX MATCH is significantly quicker than VLOOKUP"
You could try doing a Range.Find to see if the value exists at all in lookup column before proceeding. You are looping through every item in lookup column only to find it isn't there. If it were me, I would do a Range.find to see if lookup value is in lookup_column. If it is then you could do a countif to see how many occurrences there are...if there is only one occurrence, use plain old VLookup...and only fall back into your process if there is more than one occurrence.....may work....of course if Find fails, bail out of the function.
Another option is to load the lookup_column into any array...and process the array rather than the range.mnthat can sometimes help.
Summary:
Concate the values and do a vlookup on that new value.
For me I needed to have a formula and not a function to look up by 2 values. VLOOKUP could only work by a single value from what I've seen, so my solution was to concatenate the 2 values for a single primary key.
In my raw data tab I added a column called Lookup that simply concatenated the ID column with the Timestamp columns I had.
Then in my comparison tab I had
=VLOOKUP(CONCATENATE(A4, $F$1),'Historical Data'!$A:$G,3,FALSE)
Which took the ID column, concatenated with my lookup date at $F$1, and vlookup'ed into my data tab (Historical Data).