Is it possible to work in Excel with some metric suffix notation:
If I write 1000, the cell shows 1k. if I write 1000000 the cell shows 1M.
I made two functions to make a workaround but maybe there's a more suitable solution.
Function lecI(cadena) As Double
u = Right(cadena, 1)
If u = "k" Then
mult = 1000
ElseIf u = "M" Then
mult = 1000000
ElseIf u = "m" Then
mult = 0.001
End If
lecI = Val(Left(cadena, Len(cadena) - 1)) * mult
End Function
Function wriI(num) As String
If num > 1000000 Then 'M
wriI = Str(Round(num / 1000000, 2)) & "M"
ElseIf num > 1000 Then 'k
wriI = Str(Round(num / 1000, 1)) & "k"
ElseIf num < 0.01 Then 'm
wriI = Str(Round(num * 1000, 1)) & "m"
Else: wriI = Str(num)
End If
Based on the link by #Vasily, you can get the desired outcome using only Conditional Formatting. This is nice because it means that all of your values are stored as Numbers and not Text and math works like normal.
Overall steps:
Create a new conditional formatting for each block of 1000 that applies the number format for that block
Add the largest condition at the top so it formats first
Rinse and repeat to get all the ones you want
Conditional formatting used to style column C which is just random data at different powers of ten. It is the same number as column D just styled differently.
Number formats, are pretty easy since they are the same as that link, see Large Numbers section.
ones = 0 " "
thousands = 0, " k"
millions = 0,, " M"
and so on for however many you want
Automation, if you don't want to click and type all day, here is some VBA that will create all the conditional formatting for you (for current Selection). This example goes out to billions. Keep adding powers of 3 by extending the Array with more entries.
Sub CreateConditionalsForFormatting()
'add these in as powers of 3, starting at 1 = 10^0
Dim arr_markers As Variant
arr_markers = Array("", "k", "M", "B")
For i = UBound(arr_markers) To 0 Step -1
With Selection.FormatConditions.Add(xlCellValue, xlGreaterEqual, 10 ^ (3 * i))
.NumberFormat = "0" & Application.WorksheetFunction.Rept(",", i) & " "" " & arr_markers(i) & """"
.StopIfTrue = False
End With
Next
End Sub
I change the StopIfTrue value so that this does not break other conditional formatting that might exist. If the largest condition is at the top (added first) then the NumberFormat from that one holds. By default, these are created with StopIfTrue = True. This is a moot point if you do not have any other conditional formatting on these cells.
Related
I have a sheet in which our wholesale team are to enter L09 Part Codes and quickly see how much we have in stock of that item. The problem is that new starters may struggle to learn these part numbers as they don't follow a simple rule. What I did was create an easier code to remember which is simply: "Cable Type" & "Core Size" & "Cut Length", they also have the option to add "Colour" and "Brand" separated by spaces.
Their entered string may look like 6242y 2.5 100, or maybe 6242y 2.5 100 Grey, etc. and so where to look in my mapped table for what they've written depends on how many terms they put in. As you can see from the attached picture I need to select the correct column to look in for their code, and then offset back a few columns to suggest the correct L09 Part Number.
I hope the context makes a bit of sense and helps with the below code. The idea was for a new starter to enter something simple and it be replaced before their very eyes...
If anyone could help me to correct the following it would be greatly appreciated:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P, Products, S, Search As Range
Dim Column As String
Dim Counter As Integer
Dim Spaces As Long
'On Error Resume Next
Counter = 0
'For top table only
If Target.Column = 1 And Target.Row < 100 Then
'Count spaces
Spaces = UBound(Split(Target, " "), 1)
Select Case Spaces
Case Is = 2
Column = "M"
Case Is = 3
Column = "O"
Case Is = 4
Column = "Q"
End Select
'When string has spaces
If Spaces <> 0 Then
'Set simple code range
Set Search = Sheets("Cherries").Range(Column & 1 & ":" & Column & 10000)
For Each S In Search
If S = Target Then
Target = S.Offset(0, 3 - 2 * Spaces)
End If
Next S
End If
Set Products = Sheets("Order Entry").Range("A3:A99")
For Each P In Products
If P.Value <> "" Then
Counter = Counter + 1
End If
Next P
Sheets("Order Entry").Rows("3:" & Counter + 11).Hidden = False
Sheets("Order Entry").Rows(Counter + 11 & ":99").Hidden = True
End If
End Sub
Unfortunately I'm not sure which line is erroring as no error message is given.
Thank you for your time.
I have an extremely large dataset with customer numbers and we cannot just use a =IF(E3=160248, "YES", "NO") to tag a particular customer number of 160248 with YES or NO. Instead, I would like to use VBA code to lookup Customer_Number in column E and return a YES or NO in the corresponding row in Column AG, called Incorporated_160248. I have not done an If then clause in VBA, so I have no idea where to start. Please note, each month the data set can change. One month it could be 4,000 entries and the next 3,500, so that has to be dynamic. Any thoughts?
Sub TagTryco()
Dim CN As Integer, result As String
CN = Range("E:E").Value
If CN = 160248 Then
result = "YES"
Else
result = "NO"
End If
Range("AG:AG").Value = result
End Sub
I get a Compile error: Wrong number of arguments or invalid property assignment.
This CODE Works now:
Sub TagTryco()
Dim listLength
listLength = Worksheets("ILS_Import").Cells(Rows.Count, "E").End(xlUp).Row - 1
Dim i As Integer
For i = 2 To listLength + 2
If Worksheets("ILS_Import").Range("E" & i) = 160248 Then
Worksheets("ILS_Import").Range("AG" & i) = "Yes"
Else
Worksheets("ILS_Import").Range("AG" & i) = "No"
End If
Next
End Sub
To know how many entries you have:
dim listLength
listlength = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row - 1 'I assumed column E, starting at row 2
You need to loop from row 2 to the row 2 + listLength, check the cell in column E, and check if it is equal to your number:
dim i as integer
for i = 2 to listLength + 2
If Range("E" & i) = 160248 Then
Range("AG" & i) = "Yes"
Else
Range("AG" & i) = "No"
End If
Next
If you wish to scan for different numbers you can adapt the code to use a value from a cell in which you enter that number, OR use an inputbox to enter the number you want to look for, or something else. This code was not tested.
If you want to use the column name you assigned instead of AG (which is safer) you can use something along the lines of:
= Range("Incorporated_160248")(i+1)
Instead, which gives the column with an offset of i. Should bring you to the right cell.
I have 4 variables and wish to list which (maximum of 3) variables are being used.
I have used VBA functions before but I am stumped as to the reason this isn't working..
The four variables are percentages so for example:
if (20%,empty,20%,60%) I want the three cells to be (A,C,D)
if (50%,50%,empty,empty) => (A,B,empty)
Hello,
if (empty,empty,100%,empty) => (C,empty,empty)
The code I have at the moment isn't working (for the first cell):
Function whichtoa(w As Integer, x As Integer, y As Integer, z As Integer) As String
If w <> 0 Then
whichtoa = "A"
ElseIf x <> 0 Then
whichtoa = "B"
ElseIf y <> 0 Then
whichtoa = "C"
ElseIf z <> 0 Then
whichtoa = "D"
End If
End Function
Could it be to do with the empty cells being general and the others being a percentage? I can't really change this as the data is coming from another program.
Could I use a null check or something similar?
Thanks in advance!
Lucas
Consider the following data. the last column has the formula for whichtoA
A B C D E
60% 40% 30% 30% ABC
30% 60% 30% 90% ABC
10% 20% 50% ABC
30% 50% BC
30% C
50% 60% CD
If you are using percentages you need to use something other than integer in your function since you're dealing with decimals.
Function whichtoa(w As Double, x As Double, y As Double, z As Double) As String
Dim emptyCount As Integer
Dim results As String
' Assume zero
valueCount = 0
' Assume empty string
results = ""
If w <> 0 Then
results = results & "A"
valueCount = valueCount + 1
End If
If x <> 0 Then
results = results & "B"
valueCount = valueCount + 1
End If
If y <> 0 Then
results = results & "C"
valueCount = valueCount + 1
End If
' This is the only time you need to check the condition of valueCount. If you want 3 maximum
If (z <> 0) And (valueCount < 3) Then
results = results & "D"
End If
whichtoa = results
End Function
Each condition is checked individually. The If block you have will only process the first match and then stop evaluating the block. Then, counting the number of positive values, or hits if you will, with valueCount we can stop processing if we get 3 hits. This only needs to be checked with z parameter in the event we have 3 hits already at that point. Build the results as a string and return it.
Your conditional statement is chained: each ElseIf is only evaluated if the preceding If evaluates to True, so the function will only return a single string value (either A, B, C, or D but not a combination of multiple possible values, which would require stroing them all in a collection/dictionary/array/etc., and removing the ones that are empty values.
Compounded by implied type conversion (presumably you're passing range objects to this function, on a worksheet, which evaluate to their .Value which is "0" if the range is empty.
Another problem you may not have hit yet (if you're still working through the above) is that if the cell values contain percentages, by casting them as Integer in the function declaration, any values which round down to 0 will be evaluated as zero.
I suggest declaring the variables as Range objects, and then specifically check their .Value property. Store ALL cells and a key value ("A", "B", etc.) in a dictionary. Iterate the dictioanry and check the value for emptiness:
I also use this to return an error value if the dictionary contains 4 items, since you want a maximum of 3.
Function whichtoa(a As Range, b As Range, c As Range, d As Range)
Dim dict As Object
Dim itm As Variant
Set dict = CreateObject("Scripting.Dictionary")
'Add each cell value to a dictionary, using unique letter as Key
dict("A") = a.Value
dict("B") = b.Value
dict("C") = c.Value
dict("D") = d.Value
'iterate the dictionary keys, removing empty values
For Each itm In dict.Keys()
If IsEmpty(dict(itm)) Then dict.Remove (itm)
Next
If Not dict.Count = 4 Then
whichtoa = Join(dict.Keys(), ",")
Else:
whichtoa = CVerr(2023)
End If
End Function
I'm not sure exactly what the return value is that you want (your example are inconsistent), but the following may point you in the right direction:
Public Function whichtoa(r as Range)
Dim arr, i
arr = Array("A", "B", "C", "D")
For i = 0 to 3
If IsEmpty(r.Cells(1,i+1) Then
arr(i) = "empty"
End If
Next
whichtoa = arr(0) & "," & arr(1) & "," & arr(2) & "," & arr(3)
End Function
I have a really long IF AND OR formula that I'm trying to convert to VBA so it's quicker.
=IF(OR(H10<>"GL402",H10<>"GL412",H10<>"GL422",H10<>"GL432",H10<>"GL442",H10<>"GL452",H10<>"GL492",
H10<>"GL480",H10<>"GL370",H10<>"GL380",H10<>"GL710")*AND(OR(D10<>3,D10<>9,D10<>10),E10<>"ASX",
F10<>"AUD"),"F126",(IF(OR(H2="GL402",H2="GL412",H2="GL422",H2="GL432",H2="GL442",H2="GL452",H2="GL492")*
AND(OR(D2<>"3",D2<>"9",D2<>"10"),E2="ASX",F2="AUD"),"D111",.......))
I thought this should look like:
IF range("H10").Value <>""GL402"" or ""GL412"" or ""GL422"" or ""GL432"" or ""GL442"" _
or ""GL452"" or ""GL492"" or ""GL480"" or ""GL370"" or ""GL380"" or ""GL710"" AND _
range("D10").Value <>3 or 9 or 10 and range("E10").Value <>""ASX"" and _
range("F10").Value <>""AUD""
then
range("I10").Value = ""F126""
elseif
Range("H2").Value = ""GL402"" Or ""GL412"" Or ""GL422"" Or ""GL432"" Or ""GL442"" Or ""GL452"" Or ""GL492"" _
And Range("D2").Value <> 3 Or 9 Or 10 And Range("E2").Value = ""ASX"" And Range("F2").Value = ""AUD""
then
Range("I2").Value = ""D111""
elseif
another lengthy conditions with ANDs and ORs
plus I was hoping to loop this so it applies this whole IF formula until the value of cell A (whichever row) is blank.
I sort of know the loop should be
Do .........
next (with something like A1 + 1)
until A1 + 1 = ""
loop
any help appreciated!
The first rule of good code is that it should be clear - easy to read and debug. Only afterwards do you try to make it "fast". Converting your current expression to VBA may give a speed advantage but you still don't meet the first test...
You can make things cleaner with an expression like this (you can put this right in your spreadsheet):
=ISERROR(MATCH(H10,{"GL402","GL412","GL422","GL432","GL442","GL452","GL492","GL480","GL370","GL380","GL710"},0))
This will evaluate to "true" if the the value in H10 does not match any of the values in the array.
When you have a lot of or conditions in parallel, you can basically stop when the first condition is true.
An expression like that can be written in VBA as follows:
Sub test()
Dim matchStrings
Dim match1, match2
matchStrings = Array("GL402", "GL412", "GL422", "GL432", "GL442", "GL452", "GL492", "GL480", "GL370", "GL380", "GL710")
firstPart = Application.Match(Range("H10"), matchStrings, 0)
If IsError(firstPart) Then
MsgBox "no match found"
Else
match1 = true
MsgBox "match found at index " & firstPart
End If
End Sub
You can repeat similar code with other expressions, building match2, match3, etc - then combining with all the And and Or that you would like - for example
If match1 And (match2 Or match3) Then
... do something
Else
... do something else
End If
This won't work as expected:
If x = 1 Or 2 Or 3 Then
MsgBox "x is either 1, 2, or 3"
End If
because 2 and 3 aren't boolean (true/false) conditions (at least not the way you expect them to be).
The proper syntax is:
If x = 1 Or x = 2 Or x = 3 Then
MsgBox "x is either 1, 2, or 3"
End If
This is only a partial answer that nevertheless does address one of the many issues in your code.
I'm trying to minimize the value of the sum of the residuals squared by varying the value of De, which is found in F1. I want the values of CFL Calculated to be as close as possible to the values of CFL Measured. The smaller the sum of those residuals squared, the better the fit! After asking stackoverflow for some advice, I decided to use Goal Seek to minimize the sum of the residuals squared to get as close to zero as possible by varying the value of De, which I want to find the most ideal value of.
I got this program to run perfectly, or so I thought... I found out that instead of summing every single residuals using =SUM(D2:D14), I accidentally used =SUM(D2,D14). So I was only summing up the first and last numbers.
Now that I'm trying to sum every residual squared up, I'm getting these crazy errors, and an insane value for De.
I know that the value of De has to be greater than zero, and less than one. how can I use these bounds to keep this goal seek focused within a certain range? The answer for De in this case is about .012, if that helps. I keep getting the error #NUM! in all of the residual cells. Is this because of overflow issues?
If you've concluded that using Goal Seek to minimize these sums by finding the most ideal value of De will not work, how would you go about it? Are there any other solvers I could use?
Here is the code:
Option Explicit
Dim Counter As Long
Dim DeSimpleFinal As Double
Dim simpletime As Variant
Dim Tracker As Double
Dim StepAmount As Double
Dim Volume As Double
Dim SurfArea As Double
Dim pi As Double
Dim FinalTime As Variant
Dim i As Variant
Sub SimpleDeCalculationNEW()
'This is so you can have the data and the table I'm working with!
Counter = 13
Volume = 12.271846
SurfArea = 19.634954
pi = 4 * Atn(1)
Range("A1") = "Time(days)"
Range("B1") = "CFL(measured)"
Range("A2").Value = 0.083
Range("A3").Value = 0.292
Range("A4").Value = 1
Range("A5").Value = 2
Range("A6").Value = 3
Range("A7").Value = 4
Range("A8").Value = 5
Range("A9").Value = 6
Range("A10").Value = 7
Range("A11").Value = 8
Range("A12").Value = 9
Range("A13").Value = 10
Range("A14").Value = 11
Range("B2").Value = 0.0612
Range("B3").Value = 0.119
Range("B4").Value = 0.223
Range("B5").Value = 0.306
Range("B6").Value = 0.361
Range("B7").Value = 0.401
Range("B8").Value = 0.435
Range("B9").Value = 0.459
Range("B10").Value = 0.484
Range("B11").Value = 0.505
Range("B12").Value = 0.523
Range("B13").Value = 0.539
Range("B14").Value = 0.554
Range("H2").Value = Volume
Range("H1").Value = SurfArea
Range("C1") = "CFL Calculated"
Range("D1") = "Residual Squared"
Range("E1") = "De value"
Range("F1").Value = 0.1
'Inserting Equations
Range("C2") = "=((2 * $H$1) / $H$2) * SQRT(($F$1 * A2) / PI())"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C" & Counter + 1), Type:=xlFillDefault
Range("D2") = "=((ABS(B2-C2))^2)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & Counter + 1), Type:=xlFillDefault
'Summing up the residuals squared
Range("D" & Counter + 2) = "=Sum(D2: D" & Counter + 1 & ")"
'Goal Seek
Range("D" & Counter + 2).GoalSeek Goal:=0, ChangingCell:=Range("F1")
Columns("A:Z").EntireColumn.EntireColumn.AutoFit
DeSimpleFinal = Range("F1")
MsgBox ("The Final Value for DeSimple is: " & DeSimpleFinal)
End Sub
You're getting NUM errors because the value of F1 is going negative in your current solution -- and you are trying to take the square root of F1 in one of your expressions.
Also, goal seek is, in this instance, incredibly sensitive to the particular initial starting "guess" for F1 that you are using. This will be evident if you vary the F1 initial value by a little bit on either side of the 0.1 you are using now. There are, in fact, large regions of instability in the goal seek solution, depending on the F1 value:
As you brought up in your question, you are more likely to get a useable result if you can set constraints on the possible inputs to your solution search. Excel comes with an add-in called Solver that allows that, as well as offers several different search methods. Solver is not loaded automatically when you first start Excel, but loading it is easy, as explained here.
You ask for other solvers. For alternatives and a bit of theory to help understand what's going on, have a look at Numerical Recipes (online books here). Chapter 10 deals with this. It includes ready-made code samples if you want to try something different than GoalSeek or the Solver add-in. Of course the code is in Fortran/C/C++ but these are readily translated into VBA (I've done this many times).
The goalseek function uses a dichotomy algorithm which can be coded like this:
Sub dicho(ByRef target As Range, ByRef modif As Range, ByVal targetvalue As Double, ByVal a As Double, ByVal b As Double)
Dim i As Integer
Dim imax As Integer
Dim eps As Double
eps = 0.01
imax = 10
i = 0
While Abs(target.Value - targetvalue) / Abs(targetvalue) > eps And i < imax
modif.Value = (a + b) / 2
If target.Value - targetvalue > 0 Then
a = (a + b) / 2
Else
b = (a + b) / 2
End If
i = i + 1
Wend
End Sub
Where a and b are you bounds.