I have data that's in multiple formats and I am struggling to change them in an attempt to locate them. The numbers in question are currently stored as numbers in the format dataT.Range("F2:F" & lRow).NumberFormat = "###.00" However they are stored elsewhere in another spreadsheet as #### with the decimal not being included. Examples of this would be original format: "30.00" New format "3000" or Original format: "10.50" New format "1050". I attempted to remove the decimal through the Replace() Function, but I was fairly certain it would fail and it did. Any thoughts or recommendations would be much appreciated. This function is a very tiny piece of a larger routine.
Question put Simply: I need to change numbers stored in this format "30.00" to target format "3000" Line with the starts to the right is where I attempted to fix the problem
Function AnalyzeOiData(lRow As Integer, oiDataSheet As Worksheet, productSheet As Worksheet, rownum As Integer)
Dim counter As Integer
Dim monthExp As String
Dim oiLocationFinder As Range
Dim strikeLoc As Range
Dim optStrike As Long
For counter = rownum To lRow
'Returns formatted monthcode for finding the different months of expiry embedded in the OI data
monthExp = GetMonthCode(productSheet.Cells(counter, 1), productSheet.Cells(counter, 2))
optStrike = Replace(productSheet.Cells(counter, 3), ".", "") ***
oiLocationFinder = oiDataSheet.Columns(1).Find(monthExp)
oiLocationFinder.Select
strikeLoc = Range(Selection, Selection.End(xlDown)).Find(optStrike).Address
productSheet.Cells(counter, 11) = strikeLoc.Offset(0, 9)
productSheet.Cells(counter, 12) = strikeLoc.Offset(0, 10)
Next
End Function
Input each cell that you are processing into the following sub:
Sub Convert(cell As Range)
If cell.NumberFormat = "0.00" Then
cell.Value = cell.Value * 100
cell.NumberFormat = "0"
End If
End Sub
If you feed these cells in...
...the result is:
You can run an efficient search with Find rather than look at each cell:
Dim rng1 As Range
Application.FindFormat.NumberFormat = "0.00"
Set rng1 = Range("A1:A10").Find("*", , , , , , , , True)
Do While Not rng1 Is Nothing
rng1.Value2 = rng1.Value2 * 100
rng1.NumberFormat = "0"
Set rng1 = Range("A1:A10").Find("*", , , , , , , , True)
Loop
To broaden the "multiply by 100" answers into something more general, the below code will look to see how many decimal places there are, then multiply by the correct factor of 10 to remove the decimals.
Dim iDec as Integer
If Instr(1,productSheet.Cells(counter,3),".") > 0 Then
iDec = Len(productSheet.Cells(counter,3))-Application.WorksheetFunction.Find(".",productSheet.Cells(counter,3))
productSheet.Cells(counter,3) = productSheet.Cells(counter,3) * (10^iDec)
End If
I'm not 100% certain and am not anywhere that I can test right now, but would
Range ("F2").Value2 * 100
work here? It should give the underlying value without formatting, no?
Related
I'm using the following function to find out whether values of two cells are in two columns.
I have to compare 250 sets of two-cells with 6500 sets of two-cells.
Excel spent 30 seconds to caculate the result.
Could I improve the calculation efficiency?
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim result As String
result = "False"
For n = 1 To twoCols.Rows.Count
If twoCols(n, 1) = "" Then
Exit For
End If
If twoCells(1, 1) = twoCols(n, 1) And twoCells(1, 2) = twoCols(n, 2) Then
result = "True"
Exit For
End If
Next
CompareWithTwoCells = result
End Function
here's a first step of possible enhancements (explanations in comments):
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim cell As Range
Dim firstVal As Variant, secondVal As Variant
firstVal = twoCells(1, 1) ' store first cell value in a variable
secondVal = twoCells(1, 2) ' store second cell value in a variable
CompareWithTwoCells = "False"
For Each cell In twoCols.Columns(1).SpecialCells(xlCellTypeConstants) ' loop through first column not empty values
If firstVal = cell.Value2 Then ' check one column fisrt
If secondVal = cell.Offset(, 1) Then ' check second column only if first columns check is true
CompareWithTwoCells = "True"
Exit For
End If
End If
Next
End Function
a further significant enhancement would use array instead of ranges
Is there a reason you can't just use MATCH=MATCH? (assuming twoCells is A1:B1 and twoCols is F1:G6500)
=IFERROR(MATCH(A1,$F$1:$F$6500,0)=MATCH(B1,$G$1:$G$6500,0),FALSE)
This is almost instant on my machine.
As per #Zac's suggestion, add:
Dim twoCellsArr, twoColsArr
twoCellsArr = twoCells.Value2
twoColsArr = twoCols.Value2
Then change your twoCells and twoCols to twoCellsArr and twoColsArr.
If your twoCols doesn't change and you're doing repeated comparisons i recommend using a Dictionary to store the twoCols.Value as keys and the row number as values, then perform the lookup and comparing whether they are in the same row.
I would like to convert a range of numbers (and single digits) from a number-only format to alpha-numeric format. Entire statement is in a single, excel cell and would like the converted version to be in a neighboring cell.
As an example:
Assuming 1-24=B1-B24
Assuming 25-48=C1-C24
INPUT—
screen 1-3,5,7-9,11-30,32-37,39-40,41,44-46
DESIRED OUTPUT (all acceptable)
screen B1-B3,B5,B7-B9,B11-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24,C1-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24
screen C1-C6,C8-C13,C15-C16,C17,C20-C22
Using excel functions is proving quite cumbersome so excel macro would be better. I've looked for examples of requested conversion but haven't found anything.
Any help is greatly appreciated.
Cheers,
Bob
Hey here is a solution that i tested out. Not sure if "screen" needs to be in the string or not. Let me know and I will tweak it if that's the case.
Its a user defined function. So drop this vba in a module and then go to a worksheet and type in "=AlphaConvert(" + the cell reference.
Assumption here is that only one cell will be referenced at a time.
Last this could easily be converted to a sub routine and probably run a bit faster than the function.
Public Function AlphaConvert(TargetCell As Range)
Dim v As Long
Dim vArr() As String
Dim i As Long
Dim iArr() As String
Dim a As String
vArr = Split(TargetCell.Value, ",")
For v = LBound(vArr) To UBound(vArr)
If InStr(vArr(v), "-") > 0 Then
iArr = Split(vArr(v), "-")
For i = LBound(iArr) To UBound(iArr)
If i = LBound(iArr) Then
a = AlphaCode(iArr(i))
Else
a = a & "-" & AlphaCode(iArr(i))
End If
Next i
vArr(v) = a
Else
vArr(v) = AlphaCode(vArr(v))
End If
If v = LBound(vArr) Then
AlphaConvert = vArr(v)
Else
AlphaConvert = AlphaConvert & "," & vArr(v)
End If
Next v
End Function
Private Function AlphaCode(Nbr As Variant)
Select Case Nbr
Case 1 To 24
AlphaCode = "B" & Nbr
Case Else
AlphaCode = "C" & Nbr - 24
End Select
End Function
The code is a user-defined function that can be used in the worksheet. The function takes three arguments:
=MatchConcat(X1,X2,X3)
X1 = The value you want to match
X2 = The column of values that you want to match against, and
X3 = The column of values that you want to return if there is a match.
It returns a comma-delimited string of the matched values.
Now, my concern is.... I was actually looking for an alternative and much better (performs faster) VBA function same as below. Currently this VBA function below is very helpful with my large set of data. Unfortunately, using this function to a thousands of rows or even hundreds take so long to load. It took 5 to 10 minutes (for a less than 1000 rows). I have already turned off the automatic formula calculation but still having the same issue.
Function MatchConcat(LookupValue, LookupRange As Range, ValueRange As Range)
Dim lookArr()
Dim valArr()
Dim i As Long
lookArr = LookupRange
valArr = ValueRange
For i = 1 To UBound(lookArr)
If Len(lookArr(i, 1)) <> 0 Then
If lookArr(i, 1) = LookupValue Then
MatchConcat = MatchConcat & ", " & valArr(i, 1)
End If
End If
Next
MatchConcat = Mid(MatchConcat, 3, Len(MatchConcat) - 1)
End Function
I'm attempting to take the text in each cell of column A and assign a value to each cell in column B depending on the text in column A. For example, I have a list of versions that are identified by four-letter abbreviations of cities, and all of those versions are regionally assigned to different factories to be produced. So let's say I have an "AUST", "DAFW", "HOUS", and more versions all assigned to the location of "ARLINGTON". How would I most concisely use VBA to automate that once I have all the versions plugged in? Something like
If A2="AUST" Then
B2="ARLINGTON"
ElseIf A2="DAFW" Then
B2="ARLINGTON"
I suppose something like this would work, however I can't believe that there's not a faster and more concise way. Does this make any sense? I've been pulling my hair out for about a week now trying to figure this out... Thanks for any help!
This is a little simpler using OR:
If A2="AUST" OR A2="DAFW" Then
B2="ARLINGTON"
ElseIf A2 = "ABCD" OR A2 = "WZYZ" Then
B2="SOMETHING"
'ETC...
However, if you are iterating over column A, the variable "A2" is strange. But I am not sure how you are doing this. Maybe supply more code and we can help you more.
This could be done with excel formulas as well, though I always prefer to use VBA. This should work the way you want :
Sub yourFunk()
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
arlington = Array("AUST", "DAFW", "HOUS")
otherLocation = Array("XXXX", "YYYY", "ZZZZ")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For x = 2 To lastRow
If stringIsInArray(ws.Cells(x, 1), arlington) Then
ws.Cells(x, 2) = "ARLINGTON"
ElseIf stringIsInArray(ws.Cells(x, 1), otherLocation) Then
ws.Cells(x, 2) = "OTHER LOCATION"
End If
Next x
End Sub
Function stringIsInArray(stringToBeFound As String, arr As Variant) As Boolean
stringIsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
If you need me to explain the code, please do let me know :)
The fastest way is to use Dictionary.
Let's say, your data is present in the following range:
A2 = "AUST"
A3 = "DAFW"
Now, check this code:
'Needs reference to Microsoft Scripting Runtime
Sub Translate()
Dim dic As Dictionary
Dim i As Integer, sTmp As String
Set dic = New Dictionary
dic.Add "AUST", "ARLINGTON"
dic.Add "DAFW", "ARLINGTON"
For i = 2 To 3
sTmp = ThisWorkbook.Worksheets(1).Range("A" & i)
Debug.Print sTmp, "-", dic(sTmp)
Next
Set dic = Nothing
End Sub
Note: This code is just an example!
For further information please see: https://msdn.microsoft.com/en-us/library/office/gg251825.aspx
I need to be able to convert time values stored as text to number. Those that have been stored as text appear to be negative values, in this format -0:03. I need to be able to use these numbers in calculations.
Can someone advise how to fix as nothing seems to work.
Select the cells that contain the negative text time values and run this small macro:
Sub ConvertNegativeTime()
Dim r As Range, v As String
Dim t As Date
For Each r In Selection
With r
v = .Text
If Left(v, 1) = "-" Then
ary = Split(Mid(v, 2), ":")
t = TimeSerial(ary(0), ary(1), 0)
.Clear
.Value = -CDbl(t)
End If
End With
Next r
End Sub
If A1 contains your posted value, after running the macro it would contain:
-0.020833333