how to write EXCEL VBA to make my date from 04/JUNE > 04/JUNE 23:59. i cannot use the '= date + 5/6' as i have to run the VBA many times a day and it will add my dates to tomorrow/ the day after tomorrow. i just wanna make the date to end of date. please help.
The example will be like
CELL A1 : 12/June
CELL B1 : 15/June
CELL C1 : 15/June 12:00 HRS
CELL D1 : =IF C1B2, “OUT OF RANGE”, “Okay !”)
in this case D1 will still display OUT OF RANGE.
I have loads of such to change so I was thinking of writing a VBA to automatically convert C1 from 15/JUNE -> 15/JUNE 23:59 , so that D1 will display Okay !
I tried Cdate(Range(“D1”)) + 5/6 in vba to make it 23:00 hrs and I run this macro a few times in a day and it will keep adding 23hrs to the date and made it change to another date.
About what you are talking?
About:
- "Excel Formula" or
- "EXCEL VBA"
?
About:
- "Comparing Range of Date" or
- "to make my date"
?
Assume, that VBA is...
The Date type in VBA is Double, where:
- Integer part as quantity of days from... (look F1), and
- Fractional part of day.
So, your desired "04/JUNE > 04/JUNE 23:59" will:
? DateSerial(2018, 06, 4) + ((23& * 60& * 60&) + (59& * 60&)) / 86400&
18-06-04 23:59:00
Yeah, sure, you can use TimeSerialinstead of above, but ... it didn't give you right understanding of VBA dates.
.
----------
ADD:
Sorry but will this code only work for one cell because I have lots of
cells with dates and I need VBA to extract them out and convert to
23:59 for eg I run a for loop to change like 20 cells in a row with
multiple range. And I will run the macro a few times in a day will it
add 23hrs to that date every time and cause it to change dates ?
Public Sub sp_Test_Date()
Dim rSel As Range
Dim i&
Const H23M59 As Double = 1 - 60 / 86400
Set rSel = Selection
With rSel
For i = 1 To .Cells.Count
With .Cells(i)
If IsDate(.Value) Then
.Offset(0, 1).Value = CDate(Int(.Value) + H23M59)
End If
End With ' .Cells(i)
Next
End With ' rSel
End Sub
i tried modifying it to below and it failed me :(
`
Dim x As Integer
Dim test1 As Date
Dim schdWS, compWS As Worksheet
Const H23M59 As Double = 1 - 60 / 86400
Set schdWS = Sheet1
Set compWS = Sheet11
lastrow = schdWS.Cells(Rows.Count, 8).End(xlUp).Row
For x = 20 To lastrow
If IsDate(schdWS.Cells(x, 3).Value) Then
Cells(x, 3).Value = CDate(Int(Cells(x, 3).Value + H23M59))
End If
'test1.NumberFormat = "dd/mm/yyyy"
'schdWS.Cells(x, 3).FormulaR1C1 = test1 & " 23:59"
Next x
End Sub
`
Related
Trying to convert timestamps that are given in seconds after Jan first 1970. I have written a small function in Excel VBA to convert to the Excel date format. This works fine in the sense that it converts to a number that if formatted correctly gives the timestamp in an intelligible way, but I have to format the calls by hand each time. I have tried to address the issue in several ways, but either it does not do anything to the number, or it results in an error: "#VALUE." The function is called Sec2TS and if I use: 1502569847 as input it returns: 42959.8547106481, which is correct, but I would like to see: 2017 Aug 12 20:30:47. I have added the code:
Function Sec2TS(Secs As Double) As Date
If Secs > 0 Then
Sec2TS = 25569 + (Secs / 86400)
Else
Sec2TS = 0
End If
ActiveCell.NumberFormat = "yyyy mmm dd hh:mm:ss"
End Function
What is wrong with this? I have tried with set range to selection and toggling application, but to no avail.
If a formula could change formattings on a sheet, that would result in totally crazy effects for all users, because they would not know why all these odd things actually happen. That is probably the main reason why a formula/UDF cannot change anything in a worksheet, it can only return a value.
As workaround you can use the Worksheet_Change event to format the cell right after you entered a formula that contains Sec2TS. So first we check wich cells of the changed range (Target) contain formulas (Target.SpecialCells(xlCellTypeFormulas)) and then check if any cell in this range contains "Sec2TS" in its formula to .NumberFormat this cells.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellsWithFormulas As Range
On Error Resume Next
If Target.Cells.CountLarge > 1 Then
Set CellsWithFormulas = Target.SpecialCells(xlCellTypeFormulas)
ElseIf Target.HasFormula Then
Set CellsWithFormulas = Target
End If
On Error GoTo 0
If CellsWithFormulas Is Nothing Then Exit Sub
Dim Cell As Range
For Each Cell In CellsWithFormulas.Cells
If InStr(1, Cell.Formula, "Sec2TS") > 0 Then
Cell.NumberFormat = "yyyy mmm dd hh:mm:ss"
End If
Next Cell
End Sub
Note that the Target.Cells.CountLarge > 1 check is needed because if you apply SpecialCells to only one single cell VBA will apply it automatically to all cells of the worksheet which makes the code very slow.
If you don't need to process the values numerically, you can use String rather than Date as the function output:
Function Sec2TS(Secs As Double) As String
Dim D As Double
If Secs > 0 Then
D = CStr(25569# + (Secs / 86400#))
Else
D = CStr(0)
End If
Sec2TS = Format(D, "yyyy mmm dd hh:mm:ss")
End Function
Guys my primary objective is to avoid invalid days.
In sheet 1 i have:
A1 data validation with years (from 1900-2019)
B1 data validation with all months
C1 i use change event (if both fields A1 & A2 are not empty) calculate how many days the selected month has based on the selected year and create a data validation includes all available days.
For days calculation i use:
Option Explicit
Sub test()
Dim ndays As Long
With ThisWorkbook.Worksheets("Sheet1")
ndays = Day(DateSerial(.Range("A1").Value, .Range("B1").Value + 1, 1) - 1)
End With
End Sub
Sheet Structure:
Is there a batter way to calculate days?
you could use:
DateValue() function to build a date out of a string you compose with your year and month values and adding any valid day number (I chose "1" to be sure...)
EOMONTH() worksheet function to get the last day of the resulting date month:
like follows:
With someSheet
...
nb_days = Day(WorksheetFunction.EoMonth(DateValue(.Range("A1").Value & " " & .Range("B1").Value & " 1"), 0))
...
End With
I suggest to use the UDF (User Defined Function) below.
Function MonthDays(Rng As Range) As Integer
Const Y As Integer = 1
Const M As Integer = 2
Dim Arr As Variant
Application.Volatile ' recalculates on every change
If Application.WorksheetFunction.Count(Rng) = 2 Then
Arr = Rng.Value
MonthDays = DateDiff("d", DateSerial(Arr(Y, 1), Arr(M, 1), 1), _
DateSerial(Arr(Y, 1), Arr(M, 1) + 1, 1))
End If
End Function
You can call it directly from the worksheet with a function call like =MonthDays(A1:A2) where A1 holds the year and A2 holds the month. If either is missing the function returns 0. The function accepts impossible numbers for both year and month and will return a logical result, such as the 14th month of a year being the following year's February. However, you can limit the entries by data validation.
All UDFs can be called as normal functions from your code. Cells(3, 1).Value = MonthDays(Range("A1:A2")) would have the same effect as entering the function call as described in the preceding paragraph in A3. However, if the function is called from VBA the line Application.Volatile would be not required (ineffective).
I'm writing a vba subroutine in excel to store all date values between 2 dates in a single dimension array and then check for each value in a range on another sheet.
My problem is when the code is grabbing the date values (as an integer(or double - whichever one it is actually using)) it is storing a value 1462 greater than the date value on the sheet.
I am using the 1904 date system so I can use negative time values and i'm in Australia so dates are formatted dd/mm/yyyy.
As an example;
On the sheet:
01/01/2019 = 42004
In the code: 01/01/2019 = 43466
I understand the difference is the same as the difference between date values when using 1900 vs. 1904 date systems which leads me to believe perhaps VBA is defaulting the sheet value to be in 1900 and converting the value to 1904 again when the code is run?
This workbook is set up as follows:
Sheet1 contains dates from 01/01/2019 to 25/01/2019 in Range("A1:A25").
Sheet2 contains 01/01/2019 in cell A1 and 10/01/2019 in cell A2and a activeX commandbutton.
And the code:
Private Sub CommandButton1_Click()
Dim myStart As Long
Dim myEnd As Long
myStart = Me.Range("A1").Value
myEnd = Me.Range("A2").Value
Dim v As Variant
Dim x As Long
Dim myArr As Variant
ReDim myArr(0 To 100)
x = 0
For v = myStart To myEnd
If v = Empty Then Exit For
myArr(x) = v
Debug.Print ("v = " & v)
Debug.Print ("myArr = " & myArr(x))
x = x + 1
Next
Dim lastrow As Long
lastrow = Me.Cells(Rows.Count, 4).End(xlUp).Row
x = 0
For Each cell In Sheet1.Range("A1:A100")
Debug.Print (CDbl(cell))
If cell = myArr(x) Then
Me.Cells(lastrow, 3).Value = cell
Me.Cells(lastrow, 4).Value = Format(cell, "dd/mm/yyyy")
lastrow = lastrow + 1
End If
x = x + 1
Next
End Sub
The output for the cell values in columns 3 and 4 are as follows (first 5 rows for demonstration):
C D Sheet1.Range("A1:A5")[when displayed as number format]
1 43466 01/01/2019 42004
2 43467 02/01/2019 42005
3 43468 03/01/2019 42006
4 43469 04/01/2019 42007
5 43470 05/01/2019 42008
The dates are written into the cell as a short date format not numeric value.
Using the intimidate window I've noticed ?cdbl(DateValue(now)) = 43496 (31/01/2019) which is making me wonder which values are correct for the dates using the 1904 date system? Per the values in Sheet1 it should be 42034.
Is the issue caused by a data type or function I've used, is it as questioned earlier - the sheet is converting them to 1904 when the values are assigned to Sheet2 with VBA, is it a bug with excel or something else?
I found a question with the same problem here on mrexcel however the resolution there was change Excel to use the 1900 date system or subtract 1462 from the values in the code which I'm hoping to avoid both of.
In general, the date system in VBA is different than the date system in Excel. You can have these 3 date system options:
Excel date
Excel date with 1904 property
VBA date
This is the difference:
The dates are converted to numbers. E.g., every date is converted to a number, but the starting number is a bit different.
In Excel, the 1 is converted to 01.January.1900;
In VBA, the 1 is converted to 31.December.1899;
In Excel with 1904, the 1 is converted to 02.January.1904;
The 1904 system (or its lack) is set per Workbook. Thus, if you have 2 workbooks in Excel, one with 1904 and one without it, it would recognize them correspondingly. The system is set in:
File > Options > Advanced > Use 1904 Date System
In general, if there is a chance, that someone somehow changes your workbook with the wrong system, consider adding this check at the openning of the workbook:
Private Sub Workbook_Open()
If ThisWorkbook.Date1904 Then
MsgBox "System is 1904, consider some action!"
End If
End Sub
If you are wondering which system to choose - I can recommend never using the 1904.
Story for the adding VBA to Excel and the 1904 problem
To provide a solution to my example a colleague mentioned if you dim the date values as the date datatype the issues with the values going sheet -> vba -> sheet disappears.
I have a cell value, for example
A1 = 17/06/2016 19:00:46
i want to change it to 17/06/2016 19:00:00
so basically the seconds have to be 0 but i can not seem to be able to achieve that with the formatting. I did the format as dd/mm/yyyy hh:mm, but the seconds is still retaining.
i will be using these values to match the values in a different sheet using Application.Match in vba. the different sheet has the seconds as 0, hence, to match it i need to be convert these to 0 seconds.
Thank you.
The easier way to achieve this:
Function DateWithZeroSeconds(MyDate As Date)
DateWithZeroSeconds = Format(MyDate, "dd/mm/yyyy h:m") & ":00"
End Function
Select the cells you wish to convert and run this short macro:
Sub SecondKiller()
Dim d As Date, d2 As Date
For Each r In Selection
d = r.Value
r.Value = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(Hour(d), Minute(d), 0)
Next r
End Sub
An other way, format the Excel cell, and then show the seconds as 00's:
Sub FormatRange_AsDate(ByVal Rg As Range)
With Rg
.NumberFormat = "d/m/yyyy h:mm:ss;#" 'give the format to the cell , showing seconds
.Value = Format(.Value, "d/m/yyyy h:m") & ":00" 'changing the seconds to "00", don't use .value2
End With
End Sub
I am working on a spreadsheet one element of which requires a repetitive copy/paste from current column into next column, then copy/paste values back into the first column. The columns in the worksheet contain figures for each working day of the year.
The idea being to keep moving the formula along from yesterday's column into today's column. This is part of a process carried out each morning before starting to input today's data into the worksheet.
Ideally the formula would always be in today's column but the data in yesterday's column should be pasted back in as special values.
I need a macro to streamline the process.
Example:
Copy data range BM53:BM146
Paste into BN53:BN146
Copy data range BM53:BM146
Paste Special Values back into BM53:BM146
Next morning when I run the macro it should then
Copy data range BN53:BN146
Paste into BO53:BO146
Copy data range BN53:BN146
Paste Special Values back into BN53:BN146
And so on each day.
I found the code below through online searches. The code is for rows down the spreadsheet. I tried to rework it for my need which is columns across the spreadsheet but got into a mess.
Code:
Sub AddToNextRow()
Dim Count, LastRow As Integer
LastRow = Cells(35536, 3).End(xlUp).Row
For Count = 3 To 22
ActiveSheet.Cells(LastRow + 1, Count).Formula = ActiveSheet.Cells(LastRow, Count).Formula
ActiveSheet.Cells(LastRow, Count) = ActiveSheet.Cells(LastRow, Count)
Next Count
End Sub
The code you have found is rubbish. I suggest you do not visit the site where you got it again.
"35536" should have been "65536" but only if the code was posted before 2007. Until Excel 2007, the maximum number of rows in a worksheet was 65536. Since then you would be told to write Rows.Count which gives the number of rows per worksheet for the version of Excel being used.
The first task is to find the correct column. You could search from the column for 1-Jan-2015; for a macro that is only run once per day this would be acceptable. However, I have used function DatePart to find an approximate start column and have then searched backwards or forwards for the correct column. This is a bit OTT. I would normally recommend the minimum necessary to achieve the desired effect but I wanted to show you some of the possibilities.
The code you found uses ActiveSheet. This can be appropriate but rarely is. Using ActiveSheet relies on the user have the correct worksheet active when the macro is started. The macro will probably fail to find today’s date in the wrong sheet but it is better if your code explicitly references the correct worksheet.
Row 51 may be the row containing dates today but will it always be the correct row? I have made the row a parameter in a function call for the first block of code. Defining it as a constant is another option:
Const RowDate as Long = 51
I normally find using a constant the best approach for this type of problem. I have a list on constants at the top of my modules for rows, columns and anything else that is currently fixed but might change in the future. Should the value ever change, amending the constant definition is all that is necessary to fully update the macro.
I have set four rows in worksheet “Daily” to list of dates but with different start columns so I could test all the exist points from the function:
TestData
The code below output this to the Immediate Window:
Column in row 51 for today is 63=BK
Column in row 41 for today is 64=BL
Column in row 44 for today is 66=BN
Column in row 47 for today is 60=BH
Option Explicit
Sub TestFindColToday()
Dim ColToday As Long
ColToday = FindColToday("Daily", 51)
Debug.Print "Column in row 51 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 41)
Debug.Print "Column in row 41 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 44)
Debug.Print "Column in row 44 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 47)
Debug.Print "Column in row 47 for today is " & ColToday & "=" & ColNumToCode(ColToday)
End Sub
Function FindColToday(ByVal WshtName As String, RowDate As Long) As Long
Dim ColToday As Long
Dim Today As Date
Today = Date
ColToday = DatePart("y", Today) * 5 / 7
With Worksheets(WshtName)
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' This column is after the column for Today
' Move back until correct column found or does not exist
Do While True
ColToday = ColToday - 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value < Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
Else
' This column is before the column for Today
' Move forward until correct column found or does not exist
Do While True
ColToday = ColToday + 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
End If
End With
End Function
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function
I think what you are doing is copying formats, values and formulae forward one column then overwriting the formulae in the yesterday’s columns with their values. If I am wrong, I believe there is enough information for you to adjust the macro to your exactly requirements. Come back with questions as necessary but the more you can do yourself, the faster you will develop.
Sub CopyYesterdayToTodayAndFixYesterday()
' "Yesterday" is the last working day before today. For Tuesday to
' Friday this will be yesterday. For Monday it will Friday. This will
' not be true if columns are omitted for public holidays.
Const RowDate As Long = 51
Const RowCopyFirst As Long = 53
Const RowCopyLast As Long = 146
Const WshtTgtName As String = "Daily"
Dim ColToday As Long
Dim RngSrc As Range
ColToday = FindColToday("Daily", 51)
With Worksheets(WshtTgtName)
Set RngSrc = .Range(.Cells(RowCopyFirst, ColToday - 1), .Cells(RowCopyLast, ColToday - 1))
Debug.Print RngSrc.Address
' Copy yesterday's formats, values and formulae to today
RngSrc.Copy Destination:=.Cells(RowCopyFirst, ColToday)
' Overwrite yesterday's formulae with value
RngSrc.Value = RngSrc.Value
End With
End Sub
It seems you want to copy your formulas from the last used column into a new column then revert the formulas in the original to their values.
with activesheet.cells(53, columns.count).end(xltoleft).resize(94, 1)
.copy destination:=.offset(0, 1)
.value = .value
end with
You should be able to run that daily to generate new columns of formulas to the right. I'm using a set number of rows but those could be adjusted daily as well if it was known what changed them.