I have column filled with below text data
Sun Aug 30 23:49:00 IST 2015
I need to split in three columns:
Time "23:49:00"
Date "Aug 30 2015" and
Day "Sun".
You can do this without macro, but if macros are needed as part of a larger effort, then:
Sub dural()
Dim v As String, r As Range
For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
v = r.Value
If v <> "" Then
ary = Split(v, " ")
r.Offset(0, 1) = ary(3)
r.Offset(0, 2) = ary(1) & " " & ary(2) & " " & ary(5)
r.Offset(0, 3) = ary(0)
End If
Next r
End Sub
The code can be adapted to handle your choice of columns.
If the date you're attempting to read is in cell A1, then the following three formulas will work:
Day
=LEFT(A1, 3)
Date
=TRIM(MID(A1, 5, 6)) & RIGHT(A1, 5)
Time
=TRIM(MID(A1, 11, 9))
Related
I have the following text in cell A1
09-03-22
that's mm-dd-yyyy
the type is general but I want to Convert it into Date with the format dd.mm.yyyy
Can be in Excel or with vba....
Because if I change the type to date it always returns as 09.03.2022 or 09 March 2022 ... Excel thinks my month is my day and the other way around. But what I want is 03.09.2022
With VBA, this is one way to do it in the ActiveCell:
Sub TxtDateToDate()
Dim strDate As String
With ActiveCell
strDate = .Value
strDate = Split(strDate, ".")(1) & "/" & _
Split(strDate, ".")(0) & "/" & _
Split(strDate, ".")(2)
.Formula = .Value + 0 'shake cell format
.Formula = DateValue(strDate)
.NumberFormat = "MM.DD.YYYY"
End With
End Sub
If I correctly understood your case, it looks that there is a column having inconsistent Date/String data. The existing Date swaps the day with month and the string date starts with month followed by day.
If this is the case, please try the next code. It assumes that the column to be processed is A:A, and returns in column B:B. You can easily change the two columns:
Sub ConvertText_DateToDate()
Dim sh As Worksheet, lastR As Long, arr, arrD, arrStrD, i As Long
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A2:A" & lastR).Value2
ReDim arrD(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If IsNumeric(arr(i, 1)) Then
arrD(i, 1) = DateSerial(Year(arr(i, 1)), Day(arr(i, 1)), Month(arr(i, 1)))
Else
arrStrD = Split(arr(i, 1), "/")
arrD(i, 1) = DateSerial(CLng(arrStrD(2)), CLng(arrStrD(0)), CLng(arrStrD(1)))
End If
Next i
'format and drop the processed array content, at once:
With sh.Range("B2").Resize(UBound(arrD), 1)
.NumberFormat = "dd-mm-yyyy"
.Value2 = arrD
End With
End Sub
But, if the Date part did not swap day with month, you have to use
arrD(i, 1) = arr(i, 1)
Instead of:
arrD(i, 1) = DateSerial(Year(arr(i, 1)), Day(arr(i, 1)), Month(arr(i, 1)))
I have a date in cell A1 for example: 12/08/22
I want create a list with all days of the month (1-31) in column E using the month and year of the cell A1 as parameter.
Sub TESTEEEEEEE()
Dim r As Range, i As String, j As Long
i = Range("A1").Offset(0, 1).Value = Left(cell.Value, 3)
'k = ????
j = 31
For Each r In Range("E1:E31")
r.NumberFormat = "#"
r.Value = Format(DateSerial(k, i, j), "dd/m/yy")
j = j + 1
Next r
End Sub
I'm stucked in how to extract the the month and year. I was trying using the position of the characteres as parameter, but i'm not getting it work.
i should extract the 4,5 and characterer returning 08 (ok, the code is wrong i was making some tests).
k should extract the 7,8 charachter returning 22.
Someone can help me?
Please, try using the next way. It does not need iteration:
Sub testCreateWholeMonth()
Dim D As Date, lastD As Long
D = Range("A1").value
lastD = Day(WorksheetFunction.EoMonth(DateSerial(Year(D), Month(D), 1), 0))
With Range("E1:E" & lastD)
.value = Evaluate("date(" & Year(D) & "," & Month(D) & ",row(1:" & lastD & "))")
.NumberFormat = "mm.dd.yyyy"
End With
End Sub
You are probably after calendar functions like YEAR, MONTH, EOMONTH
Sub DebugDate()
Dim rg As Range
Set rg = Range("A1") ' should contain a date
Dim dt As Date
dt = rg.Value
Debug.Print Year(dt), Month(dt), CDate(WorksheetFunction.EoMonth(dt, 0))
' End of month not using worksheet function EOMONTH
Debug.Print DateSerial(Year(dt), Month(dt) + 1, 1) - 1
End Sub
Further reading on How to create a calendar with VBA
below is a VBA that when launched I get an error code of 'Run-Time error '13: Type Mismatch'.
It had worked perfectly before for General Format "dd mmm yyyy hhmm". After a couple of other VBAs it now in a Custom Format "dd mmm yyyy hhmm". The end goal is to have a blank row inserted where a date is skipped over, and have "NO DEPARTURS" placed in the blank row Column A, and for Column B and C have "N/A", and for Column D input the Missing Date in "dd mmm yyyy 0000". When debugged the line beginning with d1= cdate... is highlighted.
Sub Missing_date()
Dim d1 As Date, d2 As Date
r = 1
start:
If Cells(r + 1, "D") = "" Then Exit Sub
d1 = CDate(Split(Cells(r, "D"), " ")(1) & ", " & Split(Cells(r, "D"), " ")(0) & " " & Split(Cells(r, "D"), " ")(2))
d2 = CDate(Split(Cells(r + 1, "D"), " ")(1) & ", " & Split(Cells(r + 1, "D"), " ")(0) & " " & Split(Cells(r + 1, "D"), " ")(2))
If d2 - d1 >= 2 Then
Rows(r + 1).Insert shift:=xlDown
Cells(r + 1, "D") = Format(d1 + 1, "dd mmm yyyy 0000")
Cells(r + 1, "A") = "NO DEPARTURES"
Cells(r + 1, "B") = "N/A"
Cells(r + 1, "C") = "N/A"
End If
r = r + 1
GoTo start
End Sub
You are going to an awful lot of trouble trying to handle dates your own way rather than what Excel would like. I have taken the liberty of presuming that you had no intention of declaring war on Excel. Please try this code.
Option Explicit
Sub InsertMissingDates()
' 111
Dim NextDate As Variant
Dim CellVal As Variant
Dim R As Long ' loop counter: Rows
R = Cells(Rows.Count, "D").End(xlUp).Row
NextDate = CellDate(Cells(R, "D"))
If NextDate = vbError Then Exit Sub
' bottom rows must be inserted before top rows
For R = R - 1 To 2 Step -1
CellVal = CellDate(Cells(R, "D"))
If CellVal = vbError Then Exit For ' exit if date can't be recognised
Do While Int(CDbl(CellVal)) < Int(CDbl(NextDate - 1))
Rows(R + 1).Insert Shift:=xlDown
With Cells(R + 1, "D")
.Value = Int(CDbl(NextDate - 1))
.NumberFormat = "dd mmm yyyy hhmm"
.HorizontalAlignment = xlLeft
End With
Cells(R + 1, "A").Value = "NO DEPARTURES"
Cells(R + 1, "B").Value = "N/A"
Cells(R + 1, "C").Value = "N/A"
NextDate = NextDate - 1
Loop
NextDate = CellVal
Next R
End Sub
Private Function CellDate(Cell As Range) As Variant
' 111
' return vbError if cell's value couldn't be converted to a date
Dim Fun As Variant ' function return value
Dim CellVal As Variant
Dim Sp() As String
CellVal = Cell.Value
If IsDate(CellVal) Then
Fun = CDate(CellVal)
Else
Sp = Split(CellVal, " ")
If UBound(Sp) = 3 Then
Sp(3) = Right("0000" & Sp(3), 4)
Sp(3) = Left(Sp(3), 2) & ":" & Right(Sp(3), 2)
On Error Resume Next
Fun = CDate(Join(Sp))
End If
End If
If VarType(Fun) <> vbDate Then
MsgBox """" & CellVal & """ in row " & Cell.Row & vbCr & _
"couldn't be converted to a date.", _
vbInformation, "Data format error"
Fun = vbError
End If
CellDate = Fun
End Function
The point is that Excel takes a date to be an integer number, like 44135. Tomorrow will be 44136. Therefore each day = 1 and, therefore, each hour = 1/24. 44135.0 is 12AM and 43135.5 denotes 12PM. To display these numbers like 31 Oct 2020 1200 you don't format the number but you format the cell. This is what my code does.
Now you will have cells in your worksheet which have text that looks like a date (your entries) and dates that look like text (entries made by my code). Consider concocting a procedure which looks at the NumberFormat of each cell and changes its value to a proper date if it's Text, applying the reqired format at the same time. You can use lines of code from my above procedures to put it together. Then the function CellDate would become obsolete because its sole job is to mediate between your text dates and Excel's intentions.
This the data I have.
I just want its month name and year.
For example 201804: Apr 2018
Try this UDF
Sub Test()
Debug.Print FormatDate("201804")
End Sub
Function FormatDate(sInput As String)
sInput = "1/" & Right(sInput, 2) & "/" & Left(sInput, 4)
FormatDate = Format(CDate(sInput), "mmm yyyy")
End Function
Try
Sub test()
Dim vDB
Dim i As Long
Dim s As String, y As String, m As String
vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
For i = 2 To UBound(vDB, 1)
s = vDB(i, 1)
y = Left(s, 4)
m = Right(s, 2)
vDB(i, 1) = Format(DateSerial(y, m, 1), "mmm yyyy")
Next i
With Range("b1").Resize(UBound(vDB, 1), 1)
.NumberFormatLocal = "#"
.Value = vDB
End With
End Sub
Here is the worksheet formula, converting the date in A1. Copy the formula down as required.
=DATE(LEFT(A1,4),RIGHT(A1,2),1)
The result is a proper date set for the first day of the month, in this case April 1, 2018. The format in which this result is displayed depends entirely upon your system settings. However, you can over-ride the system by setting a custom date format in Format > Cells > Numbers > Custom*. Set Type as mmm yyyy to display Apr 2018 in the cell.
I'm trying to write a VBA to find the date in a summary sheet and populate the data to a calendar for employee vacation tracking.
The data in Summary page looks like this
Month Employee Vacation Type Start Date End Date Time
Feb Carl Half Day PM 2/26/2015 2/26/2015
Feb Hurness Half Day PM 2/26/2015 2/26/2015
Feb Edna Half Day AM 1/18/2016 2/26/2015
I wrote the code below to populate single line. I'd like to know how to populate multiple entries to calendat base on difference of start and end date
Thanks in advance for any help!
Sub AddToCalendar()
Dim R As Range
Dim lastRow As Long
Dim startDate As Integer
Dim Employee As String
Dim Reason As String
Dim Time As String
Dim sSheet As String
'locate the info in the last row of the Summary sheet
lastRow = Sheets("Summary").Cells(Rows.Count, 4).End(xlUp).row
Employee = Sheets("Summary").Cells(lastRow, 2).Value
Reason = Sheets("Summary").Cells(lastRow, 3).Value
Time = Sheets("Summary").Cells(lastRow, 6).Value
'active the worksheet of relevant month
sSheet = Sheets("Summary").Cells(lastRow, 1).Value
Worksheets(sSheet).Activate
'locate the cell of specific date and enter data
startDate = Day(Sheets("Summary").Cells(lastRow, 4).Value)
endDate = Day(Sheets("Summary").Cells(lastRow, 5).Value)
With Sheets(sSheet)
If startDate = endDate Then
Set R = .Range("A1:H58").Find(startDate)
If Not R Is Nothing Then
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
End If
Else
Do Until startDate = endDate
startDate = startDate + 1
Set R = .Range("A1:H58").Find(startDate)
If Not R Is Nothing Then
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
End If
Loop
End If
End With
End Sub
I tried to add the code to skip weekends, but I'm a bit comfused witht the logic here. Here's what I've done, could you have a look and see what's wrong please? Thanks a lot!
For i = 1 To TotalDaysOff
With Sheets(sSheet)
Set R = .Range("A1:H58").Find(startDate + (i - 2))
If Not R Is Nothing Then
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
If skipWeekend >= 6 Then
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = ""
Else
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
End If
End If
To enter multiple lines on the summary sheet based on a date range (different start date and end date), your best bet is to first figure out how many days off the employee took. This is a fairly simple arithmetic calculation, such as:
TotalDaysOff = EndDate - StartDate + 1
[NOTE: We have to add 1 to the formula to get the correct number of days. For example 2/26/2015 - 2/26-2015 would equal 0, but we know it's actually 1].
Once we have the TotalDaysOff calculated, we can create a simple loop to populate each row, such as:
If TotalDaysOff = 1 then
With Sheets(sSheet)
Set R = .Range("A1:H58").Find(startDate)
If Not R Is Nothing Then
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
End If
End With
Else
for i = 1 to TotalDaysOff
With Sheets(sSheet)
Set R = .Range("A1:H58").Find(startDate + (i - 1))
If Not R Is Nothing Then
Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
End If
End With
Next i
End If
Does this work for you?