Greetings I would like to use a VBA to create a 30 minute time range (Column B) on worksheet "Inbound Fids". For example 1015 would become 0945-1045, 0015 would become 2345-0045. I am able to create this using the formula bar, but I have to add no less than five columns. The first added Column takes text and converts it into a time format =TIMEVALUE(LEFT(D2,2)&":"&MID(D2,3,2)). The second added column takes 30 minutes off the new column, =MOD(H2-0.5/24,1). The third added column adds 30 minutes to the first added column, =(H2+0.5/24). The fourth Column combines the 2nd and 3rd Column and converts it back to text, =TEXT(I2,"hh:mm")&"-"&TEXT(J2,"hh:mm"). The last column drops the Colon =SUBSTITUTE(K2,":",""). Can we work all this into a MACRO keeping the end result in Column B. I do realize that the format is not ideal, but we have to use military time where leading zeros will not be drop and not have a colon. Lastly, I would only want this to apply Column B where only cells with numbers are considered.
Try to paste this function to your vba editor and use it as a formula in your target cell
Function GET30MINRANGE(strTime As String) As String
Dim strRange, strHour, strMin, lowerBound, upperBound As String
Dim timeVal As Date
strMin = Mid(strTime, 3, 2)
strHour = Left(strTime, 2)
timeVal = Date + TimeValue(strHour & ":" & strMin)
lowerBound = Format(timeVal - TimeSerial(0, 30, 0), "hhnn")
upperBound = Format(timeVal + TimeSerial(0, 30, 0), "hhnn")
strRange = lowerBound & "-" & upperBound
GET30MINRANGE = strRange
End Function
Like so,
=GET30MINRANGE(B2)
I use an =IF function
=IF(RIGHT(A1;1)="-";"-"&LEFT(A1;LEN(A1)-1);A1)*1
to shift a minus sign from the end of the cell to the beginning but I'd like to use it in a macro so it is performed on the same column (or the same selection)...
1) Use the the For Each.... loop construct to loop through each cell in a range.
2) If you are wanting to convert "numbers" of the 123- to -123 to a proper number and not text, use the Val command to convert a string to a number.
Note however that if you if you have cell with something like "ABC-", this will become -ABC which VBA then attempts to convert to a number ...and produces zero as a result
Sub MoveMinus()
Dim c As Range
For Each c In Intersect(Selection, Selection.Worksheet.UsedRange)
If (Right(c, 1) = "-") Then
c = Val("-" & Left(c, Len(c) - 1)) 'Val to make the result numeric
End If
Next
End Sub
The following VBA code works well if it is run as a Sub(), but when it is run as a UDF, I get a #NUM! error.
I as suspecting that there is some problem while passing values to it.
Public Function ServiceTaxInterest(PaymentDate As Date, DueDate As Date, TaxAmount As Integer) As Integer
Dim Interest As Double
Interest = 1E-32
If DueDate > PaymentDate Then
Interest = 0
ElseIf TaxAmount <= 0 Then
Interest = 0
Else
For To_day = DueDate To PaymentDate
If To_day < DateSerial(2014, 10, 1) Then
Interest = Interest + (TaxAmount * 0.18 / DaysInYear(To_day))
ElseIf MonthsDelay(DueDate, To_day) < 6 Then
Interest = Interest + (TaxAmount * 0.18 / DaysInYear(To_day))
ElseIf MonthsDelay(DueDate, To_day) < 12 Then
Interest = Interest + (TaxAmount * 0.24 / DaysInYear(To_day))
Else
Interest = Interest + (TaxAmount * 0.3 / DaysInYear(To_day))
End If
Next
End If
ServiceTaxInterest = Round(Interest, 0)
End Function
'
Public Function MonthsDelay(StartDate, EndDate) As Integer
If DateValue(StartDate) > DateValue(EndDate) Then
i = 0
ElseIf Day(EndDate) >= Day(StartDate) Then
i = ((Year(EndDate) - Year(StartDate)) * 12) + (Month(EndDate) - Month(StartDate))
Else
i = ((Year(EndDate) - Year(StartDate)) * 12) + (Month(EndDate) - Month(StartDate)) - 1
End If
MonthsDelay = i
End Function
'
Public Function DaysInYear(x) As Integer
If Int(Year(x) / 4) = Year(x) / 4 Then
DaysInYear = 366
Else
DaysInYear = 365
End If
End Function
Please help in identifying the mistake.
Thanks
Your code works correctly as a UDF (or at least produces a number and no error) for me, without modification.
I believe the error, as you suspect, is in what you're passing as parameters to the function.
What your UDF needs is something that Excel can evaluate as a number. If you have values in cells that are formatted as dates, you can pass the reference to the cell. If the date in the cell is text (for example, copied from an outside source), you can pass the DATEVALUE(text) function.
My guess is you're most likely manually typing in something like 3/25/2015 into the parameter. Excel will actually read this as a very small number (with the slashes as division) and interpret it as the completely wrong date. Simply passing "3/25/2015" with the quotes will fix that. Excel's Date object recognizes that string as a date and converts it to a value correctly.
Edit: Even safer than enclosing it in quotes, where there may be localization issues (my American-ness is showing with the month/day/year format), you can use the DATE(year,month,day) function as your input instead. Referencing a cell that's formatted as a date is safe too, as the date is just a number that's independent of how Excel is formatting it for you (yyyy/mm/dd, dd/mm/yyyy, etc.))
how are you? Look, I am opening a tab-delimited file which contains information about the day and the time when a sample was analysed. I'd like to sum time and date, in a way that would be possible to sort lines based on this information.
Time and date are stored as strings, in two different cells, just like:
Date: 29/11/2013
13:41:59:546
Because of this, I had to create a formula to remove "Date: " and to convert ":546" to milliseconds and add to the rest of the number. Unfortunately, even removing "Date: ", I can't convert "29/11/2013" to a number, considering that date is interpreted as a number by excel. It's interesting because with the workbook opened, if I select the cell with 29/11/2013 (after "Date: " being removed) and press F2, then enter, excel converts it to a number. Am I missing something when I am trying to do the same by vba?
My result should be a number that with the appropriate format
.numberformat="dd/mm/yyyy hh:mm:ss.000"
should show 29/11/2013 13:41:59.546.
My function is:
Function DateTimeCustomFormat(TimeCell As Range, DateCell As Range, formatTime As String, formatDate As String)
Dim ms As Double 'Means milliseconds
Dim msTOday As Long 'Factor to convert ms to day (ms divided by all milliseconds in a day)
msTOday = 86400000
Select Case formatTime
Case "hh:mm:ss:ms(xxx)"
ms = Val(Right(TimeCell, 3)) / msTOday
TimeCell = Left(TimeCell, Len(TimeCell) - 4)
TimeCell.NumberFormat = "0.00" '"h:mm:ss.000"
TimeCell = TimeCell + ms
End Select
Select Case formatDate
Case "Date: dd/mm/yyyy"
DateCell = Right(DateCell, Len(DateCell) - 6)
DateCell.NumberFormat = "dd:mm:aaaa"
'DateCell = DateCell.Value * 1
End Select
DateTimeCustomFormat = TimeCell + DateCell
End Function
Seems as if you not really familiar with object datatypes such as Range and with what can a user defined function do and what not.
In your code you get the parameter TimeCell as Range but then you overwrite this with a string (TimeCell = Left(TimeCell, Len(TimeCell) - 4)) and then you try setting NumberFormat to this. A string has no NumberFormat ;-). Furthermore a user defined function cannot set NumberFormat to cells and it also cannot set cell values, if this was the goal of the above code line. It only can return a value. This value gets then the value of the cell, which contains the user defined function as a formula.
Same Problem with DateCell.
Your code should get the parts of the cell values which represents the time or the date as strings and then convert them to dates. Therefor some functions are useable.
Easy to use are TimeValue and DateValue. But these functions depend on the system settings for date and time format. So it may be that they don't get the right values. For the date for example with "06/07/2014" is not really clear if it is July the 06. or June the 07. This depends on the system date format settings.
A more general solution is to use TimeSerial and DateSerial. This is the better solution in my opinion because the formates are precisely defined.
Function DateTimeCustomFormat(TimeCell As Range, DateCell As Range, formatTime As String, formatDate As String) As Date
Dim ms As Double 'Means milliseconds
Dim msTOday As Long 'Factor to convert ms to day (ms divided by all milliseconds in a day)
Dim sTime As String, sDate As String 'String parts of the given parameters
Dim dTime As Date, dDate As Date 'Calculated datetime values of the given parameters
msTOday = 86400000
Select Case formatTime
Case "hh:mm:ss:ms(xxx)"
ms = Val(Right(TimeCell.Value, 3)) / msTOday
sTime = Left(TimeCell.Value, Len(TimeCell.Value) - 4)
'dTime = TimeValue(sTime) + ms 'please read help for TimeValue
dTime = TimeSerial(Left(sTime, 2), Mid(sTime, 4, 2), Mid(sTime, 7, 2)) + ms
Case Else
dTime = 0
End Select
Select Case formatDate
Case "Date: dd/mm/yyyy"
sDate = Right(DateCell.Value, Len(DateCell.Value) - 6)
'dDate = DateValue(sDate) 'please read help for DateValue
dDate = DateSerial(Right(sDate, 4), Mid(sDate, 4, 2), Left(sDate, 2))
Case Else
dDate = 0
End Select
DateTimeCustomFormat = dTime + dDate
End Function
Using as a UDF (user defined function):
I am currently learning VBA programming by doing, and have encountered the below situation with which I would appreciate your help. Ideally not just in finding a solution, but also to understand how and why the solution works.
Say that there is a database from which one can export a spreadsheet of data. One of the columns has date values, but they are badly formatted from the export. The system sends the dates as mm/dd/yyyy hh:mm AM/PM, for example, 04/11/2014 09:24 AM, but the spreadsheet has this identified as dd/mm/..., meaning it enters 04 as the day and 11 as the month.
Within this column, if the day is before or including 12 of the month, the cell is formatted as date. If the day is past the 12th, the cell is formatted with a general format.
My question is, could I write a VBA macro that could reverse the values for day and month and create the correct dates in a new column? I would think that it would first have to identify if a cell is formatted as date, and then somehow extract the date and month in the correct positions, or if it's formatted as a general format, and then use a different code to extract the correct date.
If this is too basic an issue for this community and there's another community more suited, I will gladly repost my question there.
EDIT:
After my comment below I played around with functions and looked for other similar functions that may help do what I need, switch the day value with the month value, and so far I have:
'for dates with general format: 04/14/2014 11:20 AM
=DATE(MID(A1,7,4),LEFT(A1,2),MID(A1,4,2)) 'in a column for the date
=TIME(MID(A1,12,2),MID(A1,15,2),"00") 'in a column for time, since I may need this
'for dates with a date format: 4/11/2014 7:35:00 PM
=DATE(TEXT(A1,"yyyy"),TEXT(A1,"dd"),TEXT(A1,"mm")) 'in a column for the date
=TEXT(A1,"hh:mm AM/PM") 'in a column for time
Now I just need to figure out a conditional function to identify when to apply each set of formulas according to the values or formatting or column A.
But are there equivalent functions to achieve this through VBA? I need these date and time columns to only hold values, not formulas, so that I may export the data out of them directly. And somehow putting this in VBA code seems more "clean" to me, using formulas feels to me like a volatile solution. I'm not sure how to explain this properly, but I'm somehow more confortable with proper coding behind my data manipulation.
EDIT2:
I've resolved the worksheet functions solution as below. It took me a while to figure out how to go around the FIND error with date formatted cells, and only found the IFERROR function by chance in the list Excel suggests when writing =IF.
'to get the correct date
=IF(IFERROR(FIND("/",A1),0)>0,DATE(MID(A1,7,4),LEFT(A1,2),MID(A1,4,2)),DATE(TEXT(A1,"yyyy"),TEXT(A1,"dd"),TEXT(A1,"mm")))
'to get the correct time
=IF(IFERROR(FIND("/",A1),0)>0,TIME(MID(A1,12,2),MID(A1,15,2),"00"),TEXT(A1,"h:mm AM/PM"))
Now at least I have a working solution, but I'm still interested in a VBA translation for these formulas and will continue searching for these.
Check this out. Let's take for example your formula:
=IF(IFERROR(FIND("/",A1),0)>0,DATE(MID(A1,7,4),LEFT(A1,2),MID(A1,4,2)),DATE(TEXT(A1,"yyyy"),TEXT(A1,"dd"),TEXT(A1,"mm")))
VBA equivalent functions:
Find = Instr
Date = DateSerial
Text = Format (not exactly the same but the nearest)
Code equivalent:
Dim mydate As Date
Dim myformat As String
myformat = "mm/dd/yyyy hh:mm AM/PM"
If InStr(1, [A1], "/") > 0 Then
mydate = DateSerial(Mid(Format([A1], myformat), 7, 4), _
Left(Format([A1], myformat), 2), Mid(Format([A1], myformat), 4, 2))
Else
mydate = DateSerial(Year([A1]), Month([A1]), Day([A1]))
End If
[B1] = mydate
Take note that [A1] is a shortcut Evaluate function which can also be written as Evaluate("A1").
I used that to refer to Cell A1 as in your formula. You can use the conventional Range Object reference like this: Range("A1"). I used the shortcut because it looks cleaner. But it is not advisable in huge data sets.
For your time formula:
=IF(IFERROR(FIND("/",A1),0)>0,TIME(MID(A1,12,2),MID(A1,15,2),"00"),TEXT(A1,"h:mm AM/PM"))
Code Equivalent:
Dim mytime As Date
If InStr(1, [A1], "/") > 0 Then
mytime = TimeValue([A1])
Else
'~~> myformat is declared above
mytime = TimeValue(Format([A1], myformat))
End If
[C1] = mytime
You can also check the format of the cell like below:
Select Case True
Case [A1].NumberFormat = "General"
mydate = DateSerial(Year([A1]), Month([A1]), Day([A1]))
mytime = TimeValue(Format([A1], myformat))
Case [A1].NumberFormat = myformat '~~> again this is declared above
mydate = DateSerial(Mid(Format([A1], myformat), 7, 4), _
Left(Format([A1], myformat), 2), Mid(Format([A1], myformat), 4, 2))
mytime = TimeValue([A1])
Case Else
MsgBox "Invalid Format. Cannot be evaluated"
End Select
[B1] = mydate: [C1] = mytime
Not sure if above will really solve your problem.
There are just many possibilities when you extract datetime stamp from a database.
If the scenarios you mentioned are only the problems you encounter, then above solutions might work.
This is now an old thread but in case anyone else stumbles upon it (as I did) with a similar problem, I'm just offering this up.
My suggested VBA function for this is shown below. Its style doesn't strictly follow purist programming practice (declaration of variables, etc); it's written, rather, to be relatively easily comprehensible.
Function Date_Text_Convert( _
date_text As String, _
return_with_month_letters As Boolean, _
return_as_date_time_value As Boolean)
' Patrick S., June 2018
' Intention: to enable mm/dd/yyyy[etc] imported text-string dates
' to be switched to dd/mm/yyyy[etc]. Can be adapted for other cases.
' Usage examples: if cell A2 contains the text-string:
' 06/26/2018 09:24 AM
' then in, for example, cell B2, type:
' =Date_Text_Convert(A2,TRUE,FALSE) or =Date_Text_Convert(A2,FALSE,FALSE)
' which returns:
' 26-Jun-2018 09:24 am or 26/06/2018 09:24 am
' To return a date-and-time value instead of a string, use, for example:
' =Date_Text_Convert(A2,TRUE,TRUE)
' establish the positions where the day and month digits start
daypos = 4
mthpos = 1
rempos = 7 ' starting position of remaining part of the string
' establish the length of the relevant text sections: 2 characters each, in this case
daylen = 2
mthlen = 2
' so that,
daytext = Mid(date_text, daypos, daylen)
mthtext = Mid(date_text, mthpos, mthlen)
remtext = Mid(date_text, rempos, 999) ' the remainder of the text string
' format the output according to 'return_with_month_letters'
' there are 2 options available, each using a different separator
sep_stroke = "/"
sep_hyphen = "-"
If return_with_month_letters = True Then
mthnum = mthtext * 1
mthindex = ((mthnum - 1) * 3) + 1
mthname = Mid("JanFebMarAprMayJunJulAugSepOctNovDec", mthindex, 3)
newtext = daytext & sep_hyphen & mthname & sep_hyphen & LCase(remtext) ' LCase optional
Else
newtext = daytext & sep_stroke & mthtext & sep_stroke & UCase(remtext) ' UCase optional
End If
' finally, return the output through the function name: either as a date, or as the text equivalent
If return_as_date_time_value = True Then
newdate = DateValue(newtext) + TimeValue(newtext)
Date_Text_Convert = newdate
Else
Date_Text_Convert = newtext
End If
End Function