i need to double click on a cell.and looks like its getting edited.this is needed because i am pasting a date to cell .but it is not getting formatted as date .so if i double click it its getting formatted as date .(this is a manual work and i need it automated.
i tried using application . doubleclick method.
Cells(i, "AW").Select
Application.doubleclick
Cells(i, "AX").Select
for example,if the date i "26-08-19 23:45",when i double click it it becomes "26-08-2019 23:45:00"
Here is a suggestion. Use a validation function that is called to check the value entered into Textbox6 is a valid date and if so, update the cell with the date. Below is sample code which you may need to adapt. If you are collecting lots of dates in many text boxes then you would need to have multiple _Change functions, one for each box, or alternatively do the validation all in one go after a button click or similar user action:
Private Function CheckDate(tb As MSForms.TextBox) As Variant
CheckDate = ""
Dim dd As Date
On Error Resume Next
dd = CDate(tb.Text)
If Err.Number <> 0 Then
tb.BackColor = vbYellow
ElseIf Year(dd) < 1900 Then
tb.BackColor = vbYellow
Else
tb.BackColor = vbWhite
CheckDate = dd
End If
End Function
Private Sub TextBox6_Change()
Me.Range("D9").Value = CheckDate(TextBox6)
End Sub
Empty box:
Valid date entered:
Many formats of date are supported
If you are pasting from a textbox try and force format it as the correct date right away:
Format(Sheet1.TextBox6.Value, "dd-mm-yyyy hh:mm:ss")
Related
I'm trying to create a vba function with a string output based on a percentage cell reference that will read "Increase by __" if positive or "Decrease by __" if negative and "No change" if zero.
Any help would be great!
I normally wouldn't as someone has already said, you should be showing any efforts of what you have tried but since it's such a simple function then it's no time wasted.
Please ensure you read and understand what it does so you can learn and be able to do this sort of thing in the future. SO isn't a free code writing website.
To use this. Open Visual Basic and go Import -> Module. Don't put this in a sheet module. Then you can use it in your sheet as =PercentChange(A1) for example. You can change the name of the function to whatever you want but make sure to change all of the PercentChange to the new name otherwise it won't work.
The code:
Public Function PercentChange(rng As Range)
If rng.Value = 0 Then
PercentChange = "No Change"
ElseIf rng.Value < 0 Then
PercentChange = "Decreased by " & Format(Abs(rng.Value), "0%") 'For Decimals do "0.00%" etc
ElseIf rng.Value > 0 Then
PercentChange = "Increased by " & Format(rng.Value, "0%")
End If
End Function
You could use a custom cell format, no need for VBA:
Format Cells: Custom: Type:
"Increase by" 0.00%;"Decrease by "0.00%; "No change"
I have a two part issue regarding the same item. I have built a contracts management style system that relies on a userform to populate the worksheet and then another userform to recall the data from that sheet. This bit works perfectly. However, there is a 'start date' and 'end date' part that transfers from the userform to the worksheet.
Problem 1:
When the date is entered in dd/mm/yyyy and the 'dd' part is 1-12, it translates to US format for the date. For 'dd' values 13-31, it works fine. I have used format date code and this makes no difference.
Problem 2:
On the userform, I have an 'update' command button that overwrites any changed data back to the correct row on the excel sheet. If the date gets updated (i.e. 'end date' extended) this just returns 'FALSE' back to the cell. When I reload the contract back into the userform, it shows 31/12/1899.
Please can anyone help on any of the above?
This is the snip of the code for writing the dates for a new contract
ws.Cells(Lastrow + 1, 18).Value = TextBox18.Value
ws.Cells(Lastrow + 1, 21).Value = TextBox19.Value
This is the snip of the code for updating from the userform back to the excel sheet
Cells(rowselect, 18) = Me.TextBox18.Value = Format(TextBox18.Text, "mm/dd/yyyy")
Cells(rowselect, 21) = Me.TextBox19.Value = Format(TextBox19.Text, "mm/dd/yyyy")
I have searched many posts on here and none of the things I have tried are any better.
Thank you in advance.
For Problem 1:
If you know that the TextBox always has a date in UK-style dd/mm/yyyy, then YOU should take control of how the cell gets setup rather than relying on Excel to decide. Try code like:
arr = Split(TextBox18.Value, "/")
Cells(1, 1).Value = DateSerial(arr(2), arr(1), arr(0))
Cells(1, 1).NumberFormat = "dd mmmm yyyy"
and assuming that the TextBox gives 10/1/2021, then the result would be:
For Problem 2:
In some languages:
alpha = beta = gamma
would "daisy-chain" like:
beta = gamma
alpha = beta
VBA does not work that way. VBA sees:
alpha = (beta = gamma)
and evaluates (beta = gamma) as a Boolean; True if beta equals gamma, otherwise False
thanks for your help. I managed to fix this problem with your help to the following,
Private Sub TextBox18_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
arr = Split(TextBox18.Value, "/")
Dim dtDate As Date
dtDate = DateSerial(arr(2), arr(1), arr(0))
Me.TextBox18.Value = Format(dtDate, "dd mmmm yyyy")
End Sub
This cures the issue with the date not swapping to US as the date auto-updates in the textbox to Long Date Format.
The update issue I had to use three seperate input boxes for day, month and year and have VB put them together before updating the cell.
Thanks once again for your help.
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
So i have a multi-page form that uses two "Date and time Picker" controls named StartDate and EndDate. I want to ensure that the user does not enter the StartDate later than the EndDate. I have the following questions. Is the StartDate.value initially "" or is it null? Is what's returned by StartDate a string or a date? Here is what I have so far.
As a side remark I am also somewhat confused by this line of code even after reading the documentation.
emptyRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Private Sub StartDate_Change()
Dim emptyRow As Long
'Submits the date in the first empty row immediately since the form does not retain datepicker data after the page changes.
If (EndDate.Value) <> "" And CDate(StartDate.Value) >= CDate(EndDate.Value) Then
MsgBox ("Please enter a valid date")
MultiPage1.Value = 4
Else
Sheet1.Activate
emptyRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 18).Value = StartDate.Value
End If
End Sub
DateTimePickers return Dates.
If you want to test that the EndDate is greater than StartDate, then code such as the following should do the trick:
(StartDate.Value < EndDate.Value)
I am trying to write VBA for the first time in many years and I am having trouble getting started.
I am creating a form that users will fill out. There is no data until the user fills in the two columns. They will enter information first in column A and then in column B.
Then in each cell they can enter ABC followed by a date or XYZ followed by a date
I am trying write code that will do the following:
When a cell in column B is changed, I want to check to see if it contains the string "ABC" followed by a date (i.e. "ABC7/29/14" or "ABC 7/29/14").
Where the date format is inconsistent (i.e. sometimes it would be 07/29/2014, sometimes 7/29/14).
If the cell does contain ABC followed by a date, I want to check if that date falls within a specified date range (ie. 07/29/14 to 7/30/14). This date range will be hardcoded in.
If the date does fall within that range then I want to check the cell in the same row to the left (column A) to see if it contains the same string "ABC" followed by a date range.
If the second cell does contain ABC followed by a date I want to check if that date falls within a second specified date range (i.e. "ABC10/12/14" or "ABC 10/13/14").
If all these conditions are met I want to have a message box pop up.
Thank you so much in advance. I have written a few things for this and I am just not getting good results or even things that run correctly every time.
****EDIT****
I have updated my code to what I am currently working with. I am getting a compile Error: Object Required and it is highlighting my Set FirstPmtLDate line. Also the code is running as soon as any cell is changed. I really only want it to run when cells in B column are selected.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SecondPmt As Range
Dim FirstPmt As Range
Dim FirstPmtLDate As Date
Dim FirstPmtUDate As Date
Dim SecondPmtLDate As Date
Dim SecondPmtUDate As Date
Set SecondPmt = ActiveCell
Set FirstPmtLDate = DateValue(7 / 29 / 2014)
Set FirstPmtUDate = DateValue(7 / 30 / 2014)
Set SecondPmtLDate = DateValue(10 / 12 / 2014)
Set SecondPmtUDate = DateValue(10 / 13 / 2014)
Application.EnableEvents = False
'If target cell is empty post change, nothing will happen
If IsEmpty(Target) Then
Application.EnableEvents = True
Exit Sub
End If
'Using If Not statement with the Intersect Method to determine if Target
'cell is within specified range
If Not Intersect(Target, Range("B2:B16")) Is Nothing Then
'Checks if cell contains ABC in any case
If InStr(SecondPmt.Value, "ABC", vbTextCompare) <> 0 Then
'Remove any spaces user may entered
SecondPmt = Replace(SecondPmt, " ", "")
'Finds date after ABC in any format
SecondPmt = Mid(SecondPmt, 4)
'Checks if it is 07/29/14 or 7/30/14
SecondPmtDate = DateValue(SecondPmt)
If SecondPmtDate = SecondPmtLDate Or SecondPmtDate = SecondPmtUDate Then
'Then if it does have one of those dates the cell to the left is selected
FirstPmt = SecondPmt.Offset(0, -1)
'Checks if new cell contains ABC in any case
If InStr(FirstPmt.Value, "ABC", vbTextCompare) <> 0 Then
'Remove any spaces user may entered
FirstPmt = Replace(FirstPmt, " ", "")
'Finds date after ABC in any format
FirstPmt = Mid(FirstPmt, 4)
'Checks if it is 10/12/14 or 10/13/14
FirstPmtDate = DateValue(FirstPmt)
If FirstPmtDate = FirstPmtLDate Or FirstPmtDate = FirstPmtUDate Then
'Then if it does have one of those dates Pop up message box
MsgBox "This is not a valid entry!"
End If
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
Try this:
If InStr(s, "ABC") <> 0 Then
s = Mid(s, 4)
d = DateValue(s)
....
End If
where s is the string from your cell. Don't mind the spaces and additional zeros. The DateValue function will do it. Just check if the regional settings on your computer and in Excel are appropriate for the date format you want to use. (see the documentation)
Dont worry about the presence or not of leading zeroes in your date, the Format() function will manage that for you
dim strDate as string
dim strDateStart as string
dim strDateEnd as string
dim dtDate as date
dim dtStart as date
dim dtEnd as date
strDateStart = "07/29/2014"
strDateEnd = "07/30/2014"
' assuming your in the US and the locale date format of your system is mm/dd/aaaa as this is on what Cdate will operate on
' convert stribgs to dates
dtStart = Cdate(strDateStart)
dtEnd = Cdate(strDateEnd)
'assuming that FirstPmt contains ABCdateinanyformat
' we extract the date part (remove ABC) and we format the date
strDate = (Format( left(FirstPmt.value,4),"mm/dd/yyyy")
dtDate = Cdate(strDate)
' you can check if the date is within your range of dates like:
if dtDate >= dtStart) and (dtDate <= dtEnd) then
' do your stuff
end if