I have the above list of values. I want to first subtract first value with all other values. After that subtracting second value with all others and so on. Final result should be largest subtraction value and two cells which generated the largest subtraction value.
If you need a VBA solution, try the next code, please. Basically it adapts the formula suggestions made above by #Tom Sharpe:
Sub testLargestSubtraction()
Dim sh As Worksheet, lastRow As Long, rng As Range, maxSubstrVal As Double
Dim maxCellAddress As String, minCellAddress As String, rngMaxS As Range
Set sh = ActiveSheet ' use here your sheet
lastRow = sh.Range("A" & rows.count).End(xlUp).row
Set rng = sh.Range("A2:A" & lastRow)
maxSubstrVal = WorksheetFunction.Max(rng) - WorksheetFunction.Min(rng)
maxCellAddress = "A" & WorksheetFunction.Match(WorksheetFunction.Max(rng), rng, 0) + rng.cells(1).row - 1
minCellAddress = "A" & WorksheetFunction.Match(WorksheetFunction.Min(rng), rng, 0) + rng.cells(1).row - 1
Debug.Print maxSubstrVal, maxCellAddress, minCellAddress
Set rngMaxS = Union(sh.Range(maxCellAddress), sh.Range(minCellAddress))
rngMaxS.Select
End Sub
It returns (in Immediate Window) what you asked for and also selects the two cells which produces the largest subtraction result, independent of the range sorting.
If understand your question as wanting to find the largest difference between any of your numbers, the answer is simply
Max(numbers)-Min(numbers)
Making the simplest assumption, that there are six numbers and they are sorted into descending order, the answers are:
457.05-112.3 => 344.75 , maximum at A1, minimum at A6.
by inspection.
More generally, if you have a variable number of numbers, not sorted, the largest difference is:
=MAX(A:A)-MIN(A:A)
The largest value is at:
=MATCH(MAX(A:A),A:A,0)
And the smallest value at:
=MATCH(MIN(A:A),A:A,0)
You can create a matrix to compare all the possible pairs of numbers, but the answer will be the same. This would be only be necessary if you wanted to find the second largest, third largest difference etc.
Related
I have numbers in a column (i.e., 1 to 10 in column A) and a few numbers in another column (i.e six numbers in column E).
I want to place numbers of column E in column B randomly, so that absolute difference between An and Bn is more than my desirable number (D1).
I used RandomSelection function:
Function RandomSelection(aRng As Range)
Dim index As Integer
Randomize
index = Int(aRng.Count * Rnd + 1)
RandomSelection = aRng.Cells(index).Value
End Function
Put this in B2 and copy down:
=AGGREGATE(15,6,$E$2:$E$7/(ABS($E$2:$E$7-A2)>=$D$1),RANDBETWEEN(1,SUMPRODUCT(--(ABS($E$2:$E$7-A2)>=$D$1))))
I changed the numbers in E2:E7 so it would return values that are greater. As stated in the comments. Getting numbers 1-6 to work with 1-10 left many errors as one cannot find a number 1-6 that returns a number greater than 5 with an X of 2-5.
You can accomplish what you want by using RANDBETWEEN and ABS Formulas.
Dim RndmzRng As Range
Set RndmzRng = Range("B2:B21")
Dim AbsValRng As Range
Set AbsValRng = Range("C2:C21")
Dim cel As range
With ActiveSheet
RndmzRng.Formula = "=RANDBETWEEN(1,6)" 'so you don't need data in ColE
'can be use with cell references, "=RANDBETWEEN($E$2,$E$3") where E2=1 and E3=6
AbsValRng.Formula = "=ABS(B2-A2)" 'Absolute formula
For Each cel In AbsValRng 'colors the cells green that are > the value in Range("D1")
If cel.Value > Range("D1").Value Then
cel.Value = cel.Value - Range("D1").Value
End If
Next
End With
Right - this is a tricky one to phrase so I'm going to use a couple of images to help me.
In Columns A and B is a varying list of team names and the number of players each team has.
Column D contains the desired output.
I need a formula, to be inserted into Cell D2 and dragged down as far as the total of Column B, to return the team names - but crucially to allow a number of rows beneath which return blank. The number of blank rows beneath is effectively equal to 1 - the number of players in that team.
I have given it some thought, but can't come up with a suitable formula. Any ideas?
Also suggestions for a better title are welcome.
The following VBA function will do exactly what you want. Let me know if any part of it is not clear to you.
Sub teamRows()
Dim colDRowNumber As Integer
Dim i As Integer
Dim teamName As String
Dim numberOfRows As Integer
Dim HowFar As Integer
' Loop through the teams in column A
HowFar = Application.WorksheetFunction.CountA(Range("A:A"))
' Variable to keep count of rows in column D
colDRowNumber = 2
For i = 2 To HowFar
' Get the team's name and number of rows
teamName = Range("A" & i).Value
numberOfRows = Range("B" & i).Value
' Fill in the team's name in column D
Range("D" & colDRowNumber).Value = teamName
' Increase the row number by the number of empty rows required
colDRowNumber = colDRowNumber + numberOfRows
Next i
End Sub
A complex but short attempt - I wanted to avoid loops.
Example below works on A2 to A20
y = Split(Join(Application.Transpose(Application.Evaluate("=index(substitute(substitute(substitute(REPT(A2:A20 &"","",B2:B20),A2:A20&"","",""X"",1),A2:A20,""""),""X"",A2:a20),0,1)")), ","), ",")
[d2].Resize(UBound(y)) = Application.Transpose(y)
I am working on algorithm base tool; Kindly assist me for below problem.
1.First I find row number based on one criteria (Dynamic). Assume row number is 5 and it has set of Value From (B5:F5)
Set FindRow = SearchRange.Find(Sheet1.Cells(xRow, 2).Text, LookIn:=xlValues, lookat:=xlWhole)
MyRow = FindRow.Row
2.I have header with numeric value(B1:F1)
3.Then I need to find column number, ie MyCol is column number of minimum value cell in (B1:F1)
4.Then I test one criteria with If Cells(MyRow,MyCol)="ABC" Then test fail and again I need go and find next Minimum value in (B1:F1) and column number, ie MyCol, Until I Meet the condition.
I tried array, I am not able to find solution, Any help would be much appreciated. My Thanks in advance.
If I understand correctly, what you need is an indexed sort. Many languages provide an indexed sort as a standard function. VBA has neither a sort nor an indexed sort as standard.
With a conventional array sort, values are sorted within the array. For example: suppose I have an array with values:
A D B E C
If I pass that array to a sort, it is returned as:
A B C D E
But sometimes you cannot sort the array. In your case, the array is a range of column headings. You cannot sort those headings because they belong with their columns. You would have to sort the columns which is at best impractical and probably unacceptable since the sequence of columns will mean something.
With an indexed sort, you create arrays Keys and Indices:
Keys A D B E C
Indices 1 2 3 4 5
Both these arrays are passed to the sort which leaves Keys unchanged and sorts Indices to give:
Indices 1 3 5 2 4
With the regular sort, you access the sorted entries as Array(1). Array(2) and so on. With an indexed sort, you access the sorted entries as Array(Indices(1)). Array(Indices(2)) and so on.
Going via an index to get the sorted entries can be a little difficult to understand at first and it is undoubtedly fiddlier that going directly to the source array.
Below I have given you an indexed Insertion Sort. An Insertion Sort is simple and easy to understand but is slow with large numbers of entries. You only have five entries to sort so its performance is acceptable. Look at the Wiki entry for "Insertion Sort" for a pictorial demonstration of how it works.
Macro DemoSortColumnHeadings shows how to use the sort and how to access the column headings. I have used the name ColHeads instead of Keys and ColNums instead of Indices because I believe this will make DemoSortColumnHeadings easier to understand. The sorted ColNums contains the column numbers in the sequence you require. After the sort, the array ColHeads is no longer required.
One last point. VBA is the only language I know which allows you to specify both the lower bound and the upper bound of an array. Most languages require the lower bound to be zero. I have taken advantage of this to define the dimensions of the arrays as (2 to 6) and not (0 to 4). This is why the values in array ColNums are column numbers. With most languages, I would have needed ColNums(N)+2 to get the column number.
Option Explicit
Sub DemoSortColumnHeadings()
Const ColFirst As Long = 2 ' Column B = column 2
Const ColLast As Long = 6 ' Column F = column 6
Dim ColCrnt As Long
Dim ColNums() As Long
Dim InxColNum As Long
Dim ColHeads() As String
With Worksheets("Test data")
ReDim ColHeads(ColFirst To ColLast)
ReDim ColNums(ColFirst To ColLast)
For ColCrnt = ColFirst To ColLast
ColHeads(ColCrnt) = .Cells(1, ColCrnt).Value
ColNums(ColCrnt) = ColCrnt
Next
Debug.Print "Initial sequence"
Debug.Print "|";
For ColCrnt = ColFirst To ColLast
Debug.Print .Cells(1, ColCrnt).Value & "|";
Next
Debug.Print
Call InsertionSort(ColNums, ColHeads)
Debug.Print "Final sequence"
Debug.Print "|";
For InxColNum = LBound(ColNums) To UBound(ColNums)
ColCrnt = ColNums(InxColNum)
Debug.Print .Cells(1, ColCrnt).Value & "|";
Next
Debug.Print
End With
End Sub
Public Sub InsertionSort(ByRef Indices() As Long, ByRef Keys() As String)
Dim Found As Boolean
Dim I As Long
Dim InxIFwd As Long
Dim InxIBack As Long
For InxIFwd = LBound(Indices) + 1 To UBound(Indices)
I = Indices(InxIFwd) ' Save value of current entry in Indices
' Find first entry back, if any, such that Keys(I) >= Keys(Indices(InxIBack))
' If Keys(I) < Keys(Indices(InxIBack)), set Indices(InxIBack+1) to
' Indices(InxIBack). That is move indices for keys greater that Keys(I) down
' Indices leaving a space for I nearer the beginning.
Found = False
For InxIBack = InxIFwd - 1 To LBound(Indices) Step -1
If Keys(I) >= Keys(Indices(InxIBack)) Then
' Keys(I) belongs after Keys(Indices(InxIBack))
Indices(InxIBack + 1) = I
Found = True
Exit For
End If
Indices(InxIBack + 1) = Indices(InxIBack)
Next
If Not Found Then
' Insertion point for I not found so it belongs at beginning of Indices
Indices(LBound(Indices)) = I
End If
Next
End Sub
I have a long excel list (+10k rows) and a column with ordernumbers.
Unfortunatelly some orders were deleted.
My question is simple but to achieve probabily not: I want to count the deleted rows, basically the missing ordernumbers.
A hint is aprechiated.
endo
I don't know how to do this using Excel code, but if you go to the bottom and get the last order number, you can calculate how many there should be with
last order number - first order number = expected amount
How many their actually are would be
last order index - first order index = actual amount
Then you can do
expected amount - actual amount = missing order numbers
Of course, this assumes there are no blank rows between order numbers, and that you only need to do this once. (you prob want a function or something to have it update as you change the spreadsheet)
This covers blank rows and numbers missing from the sequence (however, if your min/max are deleted, this can't detect that). It's similar to #shieldgenerator7's answer.
No sorting necessary for this.
EDIT: As sheildgenerator7 pointed out, this assumes that you expect all of your order numbers to be sequential.
=(MAX(A2:A26)-MIN(A2:A26)+1)-COUNTA(A2:A26)
You can now count blanks in Excel with a simple function called COUNTBLANK. If you know the ending row number (for example, if the data were in A1 to A10000), you can use this formula:
=COUNTBLANK(A1:A10000)
If the numbers are sequential it is pretty easy.
Sort by order number
Count in B4
=(A4-A3)-1
Sum in B17
=SUM(B3:B16)
Here's something I put together to identify missing numbers and optionally print the list out on a new workbook.
You can change the minimum and maximum number, and it does not matter if the list is sorted or not.
Sub FindMissingNumbers()
Dim lstRange As Range
Dim r As Long
Dim lowestNumber As Long
Dim highestNumber As Long
Dim missingNumbers() As Variant
Dim m As Long
Dim wbNew As Workbook
'## Set this value to the lowest expected value in ordernumber'
lowestNumber = 0
'## Set this value to your highest expected value in ordernumber'
highestNumber = 100
'Assuming the order# are in column A, modify as needed:'
Set lstRange = Range("A1", Range("A1048576").End(xlUp))
For r = lowestNumber To highestNumber
'## Check to see if this number exists in the lstRange
If IsError(Application.Match(r, lstRange, False)) Then
'## Add this number to an array variable:'
ReDim Preserve missingNumbers(m)
missingNumbers(m) = r
m = m + 1
End If
Next
If MsgBox("There were " & m & " missing order numbers" _
& vbNewLine & "Do you want to print these numbers?", vbYesNo) = vbYes Then
Set wbNew = Workbooks.Add
With wbNew.Sheets(1)
' For r = LBound(missingNumbers) To UBound(missingNumbers)
' .Range("A1").Offset(r, 0).Value = missingNumbers(r)
' Next
.Range("A1").Resize(UBound(missingNumbers) + 1) = _
Application.WorksheetFunction.Transpose(missingNumbers)
End With
Else:
End If
End Sub
I have data stored in three columns of Excel
Column A: Serial Number
Column B: Date
Column C: Value (e.g. Cost)
I need to look for the Value (Column C) associated with a particular Serial Number (Column A) AND Date (Column B).
So for example, in the screenshot below, if I want to look for the Value associated with Serial number (T455) and Date (Dec 13, 2010), the value should be 8.
The only method I can come up with would be computationally inefficient, because I would go through ALL the cells each time I look for a value.
Is there a method, for example, that would limit the search area for a given serial number?
For example, if I am looking for a value for Serial Number T455, how can I limit the code to search for the date in Rows (6-13) and find the corresponding value in Column C, rather than searching the whole table?
Sub FindValue()
Dim S as String
Dim D as Date
Dim V as Integer
S = T455
D = Dec 13, 2010
for i = 1 to Range("A1").End(xldown).Row
If Range("A" & i) = S And Range("B" & i) < Date - 7 And Range("B" & i) < Date + 7 Then
' This way i search a date range rather than a specific date
V = Range("C" & i).Value
End If
End Sub
I thought of While loops, or Lookup functions, but reached a dead end.
Non-VBA Solution that may be a lot easier and less of a headache.
Column A consists of the formula, for A1 = "=B1&C1"
Cell G1 formula can be seen in formula bar.
UPDATE
Here is a VBA solution that will work faster, but there are some notes based on what you wrote that I am unsure of. Also, see some comments to help your code work more like you want it to.
Sub FindValue()
Dim S As String, D As Date, V As Integer, rngFound As Range, cel As Range
S = "T455" 'needs quotes around the string
D = "Dec 13, 2010" 'needs quotes around the date
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
'always better to AutoFilter than Loop when you can!
.UsedRange.AutoFilter 1, S
.UsedRange.AutoFilter 2, ">" & D - 7, xlAnd, "<" & D + 7
Set rngFound = Intersect(.UsedRange, .Columns(3)).SpecialCells(xlCellTypeVisible)
'the only thing here is if you have a date range _
'you may return more than one result _
'in that case, I don't know what you want to do with all the V's
If Not rngFound Is Nothing Then
For Each cel In rngFound
V = cel.Value
Next
End If
.AutoFilterMode = False
End With
End Sub
If you are willing to entertain a non-VBA solution, then you can use this implementation, which basically uses this formula:
=IFERROR(INDEX(List, MATCH(0, COUNTIF(H1:$H$1, List)+
IF(Category2<>Criteria2, 1, 0)+IF(Category1<>Criteria1, 1, 0), 0)), "")
There are several VBA methods, which really depend on how comfortable you are with the language and how efficient you want your solution to be. Off the top of my head:
1) filter the list with both criteria, then return the relevant value in whatever row is visible (if any)
2) sort your data by those two columns (first by serial, then date), then perform searches (you'd probably want to call built-in functions like MATCH)