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
Related
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
I realise that this is sort of a duplicate question, but the solutions mentioned in this question don't work for me completely.
My current code is as follows
Sub ConvertTextToNumber()
Dim Area As Range, C As Range
Set Area = Sheets("Tank 3").Range("C7:L7,B8:B17,C20:L20,B21:B69")
For Each C In Area
If WorksheetFunction.IsNumber(Celle) = False And C <> "" Then
C.NumberFormat = "0.0"
C.Value = C.Value + 0
End If
Next C
End Sub
This works fine on integers, but the moment the number stored as text is a decimal such as 0,1 or 0,2, it simply converts the number to 1 or 2 respectively.
I've tried using C.value = c.value after setting the NumberFormat to numbers or general, but that does nothing for me
Update: It seems the problem lies with the separators. I have to use "," as the decimal separator, and this makes the sub malfunction. If I swap the decimal separator to "." the sub runs fine.
Simply use Range.FormulaLocal to automatically cast a string to a number based on your regional settings:
Sub ConvertTextToNumber()
Dim Area As Range, C As Range
Set Area = Sheets("Tank 3").Range("C7:L7,B8:B17,C20:L20,B21:B69")
For Each C In Area
C.FormulaLocal = C.Value
Next
End Sub
You can change the separators through VBA:
Sub ChangeSeparator()
Application.DecimalSeparator = "."
Application.ThousandsSeparator = ","
Application.UseSystemSeparators = False
ConvertTextToNumber
Application.UseSystemSeparators = True
End Sub
You can use a little trick and that would be to import all the numbers as text in to your code then manipulate it and spit it back out. The comma confuses english conversions and would see 2,0 as 20. Anyway here's how you could do it
Sub ConvertTextToNumber()
Dim Area As Range, C As Range
Dim InNumAsStr As String
Set Area = Sheets("all").Range("A1:B10")
For Each C In Area
InNumAsStr = C.Text '*** force the value to be a string type ***
'***swap out any commas with decimal points ***
InNumAsStr = Replace(InNumAsStr, ",", ".")
C.NumberFormat = "0.0"
C.Value = InNumAsStr
Next C
End Sub
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?
I am having trouble figuring out how to subtract two ranges from each other, some cells in range H:H have "#N/A" while in range D:D there are no errors. I know in Excel it's a simple "=H2-D2" and drag that down but I'm in the process of recording a Macro and wanted to automate the subtraction as well. So far this is what I have:
Dim quantity1, quantity2, rIntersect, Qdiff, x As Range
Set quantity1 = Range("D:D")
Set quantity2 = Range("H:H")
Set rIntersect = Intersect(quantity1, quantity2)
For Each x In quantity1
If Intersect(rIntersect, x) Is Nothing Then
If Qdiff Is Nothing Then
Set Qdiff = x
Else
Set Qdiff = Application.Union(Qdiff, x)
End If
End If
Next x
Range("J2").Select
Dim lastRowJ As Long
lastRowJ = Range("A" & Rows.Count).End(xlUp).Row
Range("J2").AutoFill Destination:=Range("J2:J" & lastRowJ)
Place this procedure in a standard code module:
Public Sub Subtract()
[j2:j99] = [h2:h99-d2:d99]
End Sub
If you like how that works, I'm happy to embellish it so that it is not hard-coded for 98 rows only. Let me know.
UPDATE
Here is a version that will deal with any number of rows. It keys off of column D. So if there are 567 numbers in column D, then you will get 567 corresponding (subtracted) results in column J.
This assumes that the data start in row 2, and that there are no blank cells until the numbers in column D end.
If you are going to call this from the Macro Dialog then you should keep it Public. If on the other hand you are going to call it from another procedure in the same module, then you can make it Private.
Here is the enhanced solution:
Public Sub Subtract()
Dim k&
Const F = "iferror(h2:h[]-d2:d[],0)"
k = [count(d:d)]
[j2].Resize(k) = Evaluate(Replace(F, "[]", k + 1))
End Sub
Note that the routine now handles the errors and places a ZERO value in column J when the corresponding value in column H is an error. If you would prefer to have something other than a ZERO (like a blank for instance) when there are errors in column H, just let me know and I'll update to whatever you want.
UPDATE 2
Here is how to handle displaying blanks instead of zeroes:
Public Sub Subtract()
Dim k&
Const F = "iferror(if(h2:h[]-d2:d[]=0,"""",h2:h[]-d2:d[]),0)"
k = [count(d:d)]
[k2].Resize(k) = Evaluate(Replace(F, "[]", k + 1))
End Sub
I am fairly new to VBA and having some general obstacles with basic syntax. I am using the below code to trim leading spaces and color code an ActiveSheet I am currently working on.
I have another Worksheet called "Country" that I would like to apply the same logic to the current sheet I am using. I am also having difficulties using the most efficient code to find any cells with values of "AcctTotal" , " CurrTotal" and " BravoTotal" (there are about 14,000 rows of data). I am currently highlighting the whole spreadsheet and utilizing "UsedRange" to find these cells.
To sum it up:
I would like to trim leading spaces and color code any values of "AcctTotal" , " CurrTotal" and " BravoTotal" in two worksheets: "Currency" and "Country"
Sub ColorCodeCurrency()
Dim r As Range
For Each r In Selection
If r.Value = " AcctTotal" Then
r.Value = LTrim(r.Value)
Intersect(r.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 15
End If
Next r
Dim s As Range
For Each s In Selection
If s.Value = " CurrTotal" Then
s.Value = LTrim(s.Value)
Intersect(s.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 40
End If
Next s
Dim t As Range
For Each t In Selection
If t.Value = " BravoTotal" Then
t.Value = LTrim(t.Value)
Intersect(t.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 35
End If
Next t
End Sub
Most of the problem is that you're doing the same thing three times. The 'For Each' statement is going through every cell three times. If you joined it into
for each r in selection
if r.value ="AcctTotal" then
'do something
elseif r.value = "CurrTotal" then
'do something else
elseif r.value = "BravoTotal" then
'do the third thing
end if
In addition to what Maudise said, when you refer to your data, you can use syntax like:
Sheets("Country").Range("A1:E14000")
If it's possible to make changes to your source data, you may find it helpful to format it as a table for easy reference. Use the Name Manager to give the table a useful name. Then, you can say something like:
For Each r In Sheets("Country").Range("CountryTable")
You could try this way:
Public Sub ColorCode ()
Dim i As Integer, j As Integer, m As Integer, n As Integer
i = Range("A:A").End(xlDown).Row
j = Cells.End(xlToRight).Column
For m = 1 To i
For n = 1 To j
If Cells(m, n).Value < 50 Then
Cells(m, n).Interior.ColorIndex = 13
End If
Next n
Next m
End Sub
One solution is to call this code placed in a module into "This workbook" in "Private Sub Workbook_Open()".