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
Related
I have two diferent excel formatted tables one near another. First table (green headers) is a table where I have to add some chemical formulas in Column A and Column B will be SUM of all compounds that I will add from second table (yellow headers), which represents Periodic System of Elements!
The formula that I am using in Table 2 (yellow headers) for calculating chemical compounds is this:
=C$2*MAX(IFERROR(IF(FIND(C$1&ROW($1:$99);MolM.[#[Mol. Formula]]);ROW($1:$99);0);0);IFERROR(IF(FIND(C$1&CHAR(ROW($65:$90));MolM.[#[Mol. Formula]]&"Z");1;0);0)) (CSE formula)
What and how I am usually doing this update of new compounds is that I am adding new chemical formulas in Column A manually (that is okay) and then dragging main formula in Table 2 (yellow header) to calculate all elements, and then SUM in column B for the main result!
My question is, is there a possibility to be more automated, just when I type new compound in Column A it will expand as normal table do, but also to auto-expand and calculate rest of compounds, without that I drag the formula manually..?
Hopefully this was clear enough.
Is there any possibility to make this happen? Is the only solution Power Query or?
I'm making a wild guess here.
Say that you write NH3 in A3, and then have it print I2 (value of "N") in I3, and C2 * 3 (value of "H" times 3, "H3") in C3. To then have B3 calculate the total value with =SUM() or similar.
You could have a VBA sub that looks for the value and prints this.
Here is a prototype of that:
Sub molFunc(chem As String, formRow As Long)
Dim i As Long, c As String, atoms As Range, a as Range
Set atoms = Range("C1", Cells(1, Columns.count).End(xlToLeft))
For i = 1 To Len(chem)
If Not Mid(chem, i + 1, 1) = UCase(Mid(chem, i + 1, 1)) Then
c = Mid(chem, i, 2)
i = i + 1
Else
c = Mid(chem, i, 1)
End If
For Each a In atoms
If a.Value = c Then
If IsNumeric(Mid(chem, i + 1, 1)) Then
a.Offset(formRow - 1).Value = a.Offset(1) * Mid(chem, i + 1, 1)
Else
a.Offset(formRow - 1).Value = a.Offset(1)
End If
End If
Next a
Next i
End Sub
Then you can call it from a Worksheet_Change event in the worksheet of your choice.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.count = 1 Then
Application.EnableEvents = False
Call molFunc(Target.Value, Target.Row)
Application.EnableEvents = True
End If
End Sub
I have a spreadsheet in which there are multiple rows that have three columns (K, L M) that contain text (inserted manually from a dropdown). The inserted text includes a 'score'. For the row shown in the image that score is 3 + 2 + 2 = 7.
What I'd like to be able to do is to have that score automatically calculated and shown in column N. I'm happy to do the score extraction given the text, but I'm completey unfamiliar with Excel's object model, and how to write a VBA macro that can be triggered across all of the rows. I assume it would be passed a range somehow, or a string designating a range, but how to do that is beyond me just now. Perhaps I just need a formula? But one that calls a function to strip non-numerical data from the cell?
Any help appreciated.
Put this formula in N2 cell and drag it all the way down.
=LEFT(K2, FIND("-", K2) - 2) + LEFT(L2, FIND("-", L2) - 2) + LEFT(M2, FIND("-", M2) - 2)
For more information see reference. It sum all numbers, that are present before the hyphen (-) in a cell.
Try:
N2 = LEFT(TRIM(K2),1) + LEFT(TRIM(L2),1) + LEFT(TRIM(M2),1)
As I said in comments, this solution does not scale so well if it is more than three columns and / or the scores are more than single digit [0-9]
A VBA solution to do all of your rows and enter the values into Column N:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
'get the last row with data on Column A
For rownumber = 1 To LastRow 'loop through rows
For i = 11 To 13 'loop through columns
strValue = ws.Cells(rownumber, i).Value 'get text string from cell
pos = InStr(strValue, " -") 'find the dash - in cell
If pos > 0 Then 'if dash found
Value = Value + Val(Left(ws.Cells(rownumber, i).Value, pos - 1)) 'remove everything after number
End If
Next i
ws.Cells(rownumber, 14).Value = Value 'write value to column N
Value = 0
Next rownumber
End Sub
The problem:
There is a range with double values. I would like to get the address of the maximum value.
I tried with the match function, but it can't compare doubles (gives false results), and my range isn't ordered.
There are ugly solutions (for example I can multiply my numbers by 10000, if I want 5 digit precision, then get the integer part and compare that, but it is very slow with more than 20000 rows) and maybe there are more elegant solutions.
Thanks :)
Sample Data: These are the numbers after Debug.Print
B 7.59999999999934E-02
C 7.00000000000074E-02
D 0.335000000000008
E 8.19999999999936E-02
F 8.49999999999937E-02
G 7.39999999999981E-02
H 5.49999999999926E-02
I 0.070999999999998
J 0.165000000000006
K 7.59999999999934E-02
Why not just iterate your range and change a variable if the next cell double value is greater? Once you finish this range use the find to return cell row and column. See below
Dim i as Variant
For Each i In Worksheets("yourWorkSheet").Range(Range("youStartCell"), Range("yourStartCell").End(xlDown)).Cells
If i.Offset(-1) < i Then
i = i.value
End if
Next
Should look something like this. Need to handle the first row case in loop but if i did that you would have no work to do.
This is my final solution:
'Find max and its address in range
Public Function maxAddress(rng As Range) As DoubleLong
Dim cell As Range
For Each cell In rng
If IsNumeric(cell.Value2) Then
If cell.Value2 > maxAddress.db Then
maxAddress.db = cell.Value2
maxAddress.lg = cell.Row
End If
End If
Next cell
End Function
where is defined a type:
Public Type DoubleLong
db As Double
lg As Long
End Type
I have a spreadsheet with a load of random text and numbers in column A like so:
Column A
Row 1 = 471806121601 5205569 - 0007 Standard White Toilet Tissue 27
Row 2 = 471814121601 5206177 - 0014 Premium White Toilet Tissue 6
Row 3 = 471814121601 5206178 - 0007 Premium White Toilet Tissue 27
Row 4 = 471806121601 5206180 - 0014 Premium Kitchen Towel 2x75l 6
I have about 2000 lines in total. In each cell, is a Purchase order number (12 digits) and an item number next to it (7 digits).
I am trying to extract the po number and put it into column B and extract the item number and put it into column C
Column B Column C
471806121601 5205569
471814121601 5206177
471814121601 5206178
471806121601 5206180
Here is my code:
Option Explicit
Sub main()
Dim cell As Range
Dim arr As Variant, arrElem As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr = Split(Replace(cell.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem In arr
If IsNumeric(arrElem) Then
If Len(arrElem) = 12 Then cell.Offset(0, 1).Value = arrElem
End If
Next arrElem
Next cell
End With
Dim cell2 As Range
Dim arr2 As Variant, arrElem2 As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell2 In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr2 = Split(Replace(cell2.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem2 In arr2
If IsNumeric(arrElem2) Then
If Len(arrElem2) = 7 Then cell2.Offset(0, 3).Value = arrElem2
End If
Next arrElem2
Next cell2
End With
End Sub
This code does work. However it takes absolutely ages and only does one line at a time...Slowly.
Is there a quicker way of doing this? Thanks
If your PO and IN are always the same length in col B put
=MID(A2, 1, 12)
And in col C
=MID(A2, 14, 7)
However if your number change but are always the first two swap the above for,
=MID(A2,1,FIND(" ",A2,1)-1)
And
=MID(A2, FIND(" ", A2, 1)+1, 7)
Respectively.
just use split(string,delimiter)(0) and (1) why replace the space, just use that as the delim. If Row # is in, then use (1) and (2), or you could consider split(split(input,"-")," ") maybe a little faster, not sure though. Also, once you're done no need to complete the loop, so consider, do until with flags rather than for next, although exit for is available
Formula wise, it could be done using something like this
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",3)),FIND("é",SUBSTITUTE(D1," ","é",4))-FIND("é",SUBSTITUTE(D1," ","é",3)))
and
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",4)),FIND("é",SUBSTITUTE(D1," ","é",5))-FIND("é",SUBSTITUTE(D1," ","é",4)))
I have a list of usernames sorted alphabetically in column A, with some appearing numerous times.
I want to prnt the username in column B if it appears less than or equal to 4 times.
Do I need an array to go through all the different username values in the column to find the ones that appear less than or equal to 4 times?
Consider:
Sub dural()
Dim A As Range, B As Range, v As String, K As Long
Set A = Intersect(Range("A:A"), ActiveSheet.UsedRange)
Set B = Range("B:B")
K = 1
With Application.WorksheetFunction
For Each aa In A
v = aa.Value
If v <> "" Then
If .CountIf(A, v) <= 4 Then
If .CountIf(B, v) = 0 Then
Cells(K, "B").Value = v
K = K + 1
End If
End If
End If
Next aa
End With
End Sub
Add a helper column and place the following formula in the second row:
=IF(AND(COUNTIF(A:A,A2)<=4,COUNTIF($A$2:A2,A2)=1),MAX($B$1:B1)+1,"")
And copy down:
At this point you can filter on the non Blank Cells and copy them to another range.
If you want to use a formula to get the list then Put this in another column row 2:
=IFERROR(INDEX(A:A,MATCH(ROW(1:1),B:B,0)),"")
And copy down.
No need for helper columns or VBA, just a bit of finely-tuned IF functions :)
=IF(COUNTIFS(BE:BE,BE2)<=4,IF(COUNTIFS($BE$1:BE2,BE2)=1,BE2,"0"),"0")
^Here, BE is where all your data is, starting on Row 2
What it does:
If the Name appears 4 or fewer times,
If this is the first time the Name appears in the column
Print the Name
(Otherwise insert 0)
To remove the 0 values i.e empty rows:
Paste over the formula with the same column as values (this is so you can..)
.. Replace All (Ctrl-H) "0"s with nothing "" (so that you can..)
.. Select the blank rows using Go To (Ctrl-G) > Special > Blanks
Delete (Shift Cells Up)
You can also simply Filter out the Blank/0 values