I am doing a form and I am finding myself with a weird problem with the TextBox.
I ask the user to insert some data and when it does, the TextBox changes the data.
An example, if the user inserts: 03/01/2013 and then the runs the form, the form instead to perform the code with the original data changes it, 01/03/2013.
I realized that always changes the day and the month, but never the year.
Extra information, I never "told" the form that the data it is gonna process it is a date.
I am struggling to make it work it out, so any help will be grateful.
If extra info is needed, please let me know it.
Code:
Private Sub CommandButton1_Click()
ThisWorkbook.Sheets("Hidden").Range("D1").Value = TextBox1.Value
ThisWorkbook.Sheets("Hidden").Range("D2").Value = TextBox2.Value
If TextBox1.Value < TextBox2.Value Then
If TextBox1.Value = "" Or TextBox2.Value = "" Then
MsgBox "...", vbExclamation, " ..."
Else
Run "macro"
ThisWorkbook.Sheets("SUMUP").Range("D11").Value = TextBox1.Value
ThisWorkbook.Sheets("SUMUP").Range("D12").Value = TextBox2.Value
End If
Else
MsgBox "..." & vbCrLf & "...", vbExclamation, " ..."
End If
End Sub
Thanks.
It's a VBA :]. Just convert to string by:
ThisWorkbook.Sheets("SUMUP").Range("D11") = Format(TextBox1.Value, "dd/MM/yyyy")
The most common issue related to your description:
you may be saving the users input into a cell. If So, please check the formatting of that cell.
Please provide more info on how the users input is stored. What datatype variable are you using to store the users input? What is the migration process for the input?
Post-Edit:
Format your cells ( simplest solution )
Range = Format(TextBox1.Value, "dd/mm/yyyy")
P.S.
You can store your users input in variables:
Dim txtb1, txtb2 As String
'ThisWorkbook.Sheets("Hidden").Range("D1").Value = TextBox1.Value
'ThisWorkbook.Sheets("Hidden").Range("D2").Value = TextBox2.Value
'
' instead of storing the value in cell, use variables ( now youre not going to need a "hidden" sheet
'
txtb1 = TextBox1.Value
txtb2 = TextBox2.Value
Hope this helps.
You have to change the date format of your system in order to accept the input format of your vba form. Go to
Start>Control panel>Clock
Language and Date, under Region and Language select Change date, time or number format. Under date and time format select the drop-down in front of Short Date then select dd-mmm-yy. Do thesame on long date and select dddd,mmmm dd,yyyy. I hope this would be helpful
Related
I'm writing some VBA code that should go through all Excel files in a specific folder (folder names always formatted with Month Year, e.g. May 2020). In my code I also need to use the individual "Month" and "Year" strings e.g. "May" and "2020", and the date format mm/??/yy e.g. 5/??/20 (the day doesn't matter, so I just put ? as a placeholder) which are stored as variables.
So far, I am using Application.FileDialog(msoFileDialogFolderPicker) to let the user choose the folder, and I'm using InputBox("") three times to get the strings and date.
Is there a way to condense this so that the user only has to do one to two things, instead of four?
According to this answer combo box in a date format it seems like a combo box could work (maybe getting the month and year inputs as strings and getting the folder and date based on that?), but is there a better a way?
Any help would be appreciated!
This is the way it might work.
Ask the user for a date
From the date the macro creates the folder name
The path of the folder is stored in the macro
The code below implements and supports that work flow.
Sub GetFolderName()
Dim Inp As String
Dim FolderName As String
Dim FilePath As String
' make sure you ask for a date format that your computer can recognise
' it depends upon your Regional Settings (in Windows Control Panel)
Do
Inp = InputBox("Enter a date", "Date format dd/mm/yy", _
Format(Date, "dd/mm/yy"))
If Inp = "" Then Exit Sub ' blank or Cancel
If Not IsDate(Inp) Then
MsgBox "Sorry, I can't recognise your entry" & vbCr & _
"as a date. Please observe the date" & vbCr & _
"format requirement and try again."
End If
Loop While Not IsDate(Inp)
FilePath = Environ("userprofile") & "\Desktop\"
FolderName = Format(CDate(Inp), "mmmm yyyy")
MsgBox "Folder name is """ & FolderName & """" & vbCr & _
"File path = " & FilePath
' complete path is
Debug.Print FilePath & FolderName
End Sub
Note that the following options were not utilized but are still available.
Day(Cdate(Inp)) ' returns the day of the entered date
Month(Cdate(Inp)) ' returns the number of the month of the entered date
Year(Cdate(Inp)) ' returns the year of the entered date (45-digit)
Update as of June 11, 2019: I still haven’t figured out why practically all of my delay happens in those two lines, but current status is that I put up with the delay. So far, I have about 6000 rows of data in the master document, and an import process takes about 20 seconds regardless of how many rows I import.
—
I have a "master document" and I import data from lots and lots of little documents all day long. I admit I'm not a super-genius here, and a lot of my coding habits come from doing it "old school" so there may be "Excel ways" that I don't know (but want to learn!).
The issue I'm seeing is how much time a data file import can take.
When I started the tool out, data imports took only a few seconds.
Now that I have about 3500 rows of data, data imports take about 15-20 seconds. It doesn't matter if I am importing one row or a hundred rows. I expect this to keep going up. By the time I get to 7000 rows or 10,000 rows, I expect it to become unbearable.
By using message boxes (remember: "old school"), I've been able to narrow the speed bottleneck down to two lines of code. Between "Step 1" and "Step 2" is about 30% of my delay, and between "Step 2" and "Step 3" is about 70% of my delay.
I've included the whole sub below to make sure I'm not missing something obvious, but I made sure to UNINDENT my message boxes so you can go r-i-g-h-t to the code I suspect. Also, I included the entire sub because usually one of the first responses is “can you show the whole sub so I have better context?”
Thank you kindly for any thoughts or suggestions you might have. :)
Private Sub Btn_ImportDataFiles_Click()
' Search the current worksheet and assign the next TransactionID
Dim TransactionCounter As Integer
Dim TransactionID As Long ' This is the next available Transaction ID
TransactionID = Application.WorksheetFunction.Max(Range("a:a")) + 1
' open the file and import the data
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
If customerFilename <> "False" Then
' If they have uploaded the file before, let them know.
' If they want to keep uploading it, no harm done,
' but no need to stupidly add data that is already present.
' Select the archive sheet
Sheets("Upload_Archive").Select
Dim FileNameHunt As String
Dim cell As Range
Dim ContinueUpload As Boolean
ContinueUpload = True
FileNameHunt = Mid(customerFilename, InStrRev(customerFilename, "\") + 1)
Columns("A:A").Select
Set cell = Selection.Find(what:=FileNameHunt, after:=ActiveCell, LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
If cell Is Nothing Then ' Add the new filename to the archive
Sheets("Upload_Archive").Select
Rows(1).Insert shift:=xlDown
Range("a1:a1").Value = FileNameHunt
Sheets("MasterSheet").Select
Application.Cells.Font.Name = "Calibri Light"
Application.Cells.Font.Size = "8"
Application.Cells.Font.Bold = False
Else
response = MsgBox("This data file has previously been uploaded. " & vbCrLf & "Do you want to cancel this upload?" & vbCrLf & vbCrLf & "Pressing [yes] will cancel the process." & vbCrLf & "Pressing [no] will continue with the file upload" & vbCrLf & "and add the data to the tracking sheet.", vbYesNo)
If response = vbYes Then
ContinueUpload = False
Sheets("MasterSheet").Select
Exit Sub
End If
End If ' If cell Is Nothing Then...
If ContinueUpload = True Then
' Continue with data upload procedure
Sheets("MasterSheet").Select
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
' Copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
Dim ImportRecordCount As Integer
ImportRecordCount = sourceSheet.Range("B1")
Dim ReconciliationID As String
ReconciliationID = ""
If sourceSheet.Range("E3") = "Removed from Depot" Then ReconciliationID = "1"
MsgBox ("Step 1")
targetSheet.Range("A1").EntireRow.Offset(1).Resize(ImportRecordCount).Insert shift:=xlDown ' Add the blank rows
MsgBox ("Step 2")
targetSheet.Range("B2:AB" & ImportRecordCount + 1).Value = sourceSheet.Range("A3:AA" & ImportRecordCount + 2).Value ' Bring in the big pile of data
MsgBox ("Step 3")
targetSheet.Range("AJ2:AJ" & ImportRecordCount + 1).Value = ReconciliationID ' To help with reconciling shipments
targetSheet.Range("AK2:AK" & ImportRecordCount + 1).Value = ReconciliationID ' To help with deployment timing
'targetSheet.Range("AI2:AI" & ImportRecordCount + 1).Value = "=COUNTIFS($D:$D, D2, $F:$F, F2)" ' This is the helper formula for identifying duplicates (deprecated, but I'm saving the code)
For TransactionCounter = 2 To ImportRecordCount + 1 ' Create and add the new Transaction ID values
targetSheet.Range("a" & TransactionCounter) = TransactionID + ImportRecordCount - TransactionCounter + 1
Next
' Close customer workbook
customerWorkbook.Close
' Format the sheet properly
Application.Cells.Font.Name = "Calibri Light"
Application.Cells.Font.Size = "8"
Application.Cells.Font.Bold = False
Application.Range("1:1").Font.Size = "10"
Application.Range("1:1").Font.Bold = True
' Query the User -- delete the file?
If MsgBox("Delete the local client-generated data file?" & vbCrLf & vbCrLf & "(this will NOT affect your email)", vbYesNo, "Confirm") = vbYes Then
Kill customerFilename
' MsgBox ("File: " & vbCrLf & customerFilename & vbCrLf & "has been deleted.")
End If
End If ' If ContinueUpload = True Then
End If ' If customerFilename <> "False" Then
End Sub
edit
I edited your original question to highlight things I found as suspect. These are things I felt are worth pointing out to you. I shaved everything else out as to focus on these particular issue. Review them and do soem research to see if you can find yourself in a better situation.
MsgBox ("Step 2")
'Ive never moved large amounts of data using this method. Ive always just used arrays. I have moved smaller bits of data though.
' I suspect that this might take a moment if the data set is large. Again use arrays to grab the data and move it.
' Edward says “This step takes about 70% of my delay — even if bringing in only a single line of data.”
targetSheet.Range("B2:AB" & ImportRecordCount + 1).Value = sourceSheet.Range("A3:AA" & ImportRecordCount + 2).Value ' Bring in the big pile of data
MsgBox ("Step 3")
' this loop is probably your main culprit of your performance issue.
' Edward says “Nope, this flies by. It is not the issue at all. I have verified this already.”
' Learn how to construct an array of data on the fly and then learn how to dump the entire array to
' sheet using a simple method.
For TransactionCounter = 2 To ImportRecordCount + 1 ' Create and add the new Transaction ID values
targetSheet.Range("a" & TransactionCounter) = TransactionID + ImportRecordCount - TransactionCounter + 1
Next
It looks like you have a lot of good things going here. A few things that I saw that could potentially be changed to improve your performance.
First, between "Step 1" and "Step 2": In my experience, adding rows takes longer than using rows that already exist. It looks like you are basically "pushing" everything down to make room for the new data, such that the newly entered data is at the top and the oldest data is at the bottom. (Correct me if I am wrong on any of this.) If you were to simply add the data to the end of the sheet, you would probably see some performance improvements, although I don't know how big of an improvement it would be.
Second, between "Step 2" and "Step 3": I have found that using .Value2 as opposed to .Value can give you some performance improvements, and the larger the data the bigger the improvement. This has a down side - Value2 does not retain any of the formatting that might be present, meaning that the number type (date, accounting, etc) does not pull over correctly. If this is something that you do not need, then you can use Value2.
Finally, other methods: When I run extensive macros, I always try to do everything I can to get a performance boost. You can get slight boosts across the board by using tricks like turning off screen updating (Application.ScreenUpdating = False), just be sure to turn it back on at the end of the macro.
I hope that this helps you figure it out! If all else fails, you can do it once or twice by hand to remember how much faster it is using the macro! Haha. Good Luck!
Have you tried using .value2? In some scenarios it might bring you better performance. Check some performance comparatives here: https://fastexcel.wordpress.com/2011/11/30/text-vs-value-vs-value2-slow-text-and-how-to-avoid-it/
It's difficult seeing where's the issue without having access to the original sheets. Maybe the issue is with the data itself instead of your VBA code and sometimes you might need to clean your source data of the heavy stuff and then add it again if needed.
You could also look into doing some parts with Python but I guess that's out of the question if you don't want to add additional software layers to your solution.
Try adding this at the beginning and end of your script. Just be sure to set everything back to TRUE!!
Application.ScreenUpdating = False
Application.DisplayAlerts = False
...CODE HERE...
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Context: I have 10 text boxes (ID1 To ID10) in a user form. The userform will also have a clear button, which will allow the user to clear all the values previously entered in the text box. For that I have inserted the below mentioned command in the Clear Button.
I have multiple commands with the same nomenclature except the number which varies with every text box. I wish to enter one command which will change number and execute all the commands.
Simple example given below: I wish to only put one command instead of the folloing:
Private Sub btnClear_Click()
'Empty ID1
ID1.Value = ""
'Empty ID2
ID2.Value = ""
'Empty ID3
ID3.Value = ""
.
.
. and so on till
.
'Empty ID10
ID10.Value = ""
End Sub
I know there is a solution to this, but since I am new cannot find on google using the correct key words. Sorry if this already exists. Any help will be appreciated. Thank you.
If these are TextBoxes on a UserForm, you will be able to do the following from a macro in the UserForm's code module:
Private Sub btnClear_Click()
Dim i As Long
For i = 1 To 10
Me.Controls("ID" & i).Value = ""
Next
End Sub
It's not possible to dynamically generate a variable and/or object name but, because the Controls collection can be indexed by the "name" of the control, it gives an alternative way of getting at the objects.
Adding in code for "option boxes" (OptionButtons? `CheckBoxes?) mentioned in comments, and changing the TextBox names to end with a "C":
Private Sub btnClear_Click()
Dim i As Long
For i = 1 To 10
Me.Controls("ID" & i & "C").Value = ""
Me.Controls("OB" & i).Value = False
Next
End Sub
Do you mean something like this?
For i=1 to 4
str="ID" & i & ".Value = ''"
Evaluate(str)
Next
In my organization we have an Excel template that all employees have to fill frequently. This template originates hundreds/thousands of Excel files (workbooks) per year.
For the sake of organisation, I urgently need to have a unique ID for each of these files (i.e. unique ID per workbook generated by this template).
Currently, my idea is to generate the following ID in a cell of the workbook:
[user]-[YYYYMMDD]-[hhmmss]
in which:
user is a string representing the username of the employee which would be filled in by the user. So no problem here.
YYYYMMDD is year, month and day
concatenated
hhmmss is hour, minute and second concatenated
For this effect, I would need that my Excel template automatically fills a cell with the YYYYMMDD-hhmmss information with the exact date and time of generation.
This information should be created once the template generates the workbook, and cannot be changed ever after. So these should be values in a (protected) cell and not a formula (I guess).
I cannot figure out how to do this after searching for a long time. I am not sure if it is needed or not, but I am no master of VBA.
The idea of having a date/time field is good .... create a workbook smilar to this
add the following code to the ThisWorkbook module:
Private Sub Workbook_Open()
If [B2] = "" Then
' timestamp
[B2] = Now()
' suppress warning when saving macro containing workbook in non-macro format
Application.DisplayAlerts = False
' save under calculated name
ActiveWorkbook.SaveAs [B1] & "-" & Format([B2], "YYYYMMDD-hhmmss")
' turn on alerts again
Application.DisplayAlerts = True
End If
End Sub
and save as a macro enabled template
Then create a [File - New] from this template .... it will immediately be saved under the name of the user with macros removed so that the code can't hit it another time.
The user name could be retrived from the environment or from the registry.
Alternatively you can examine if the file has a true name or (still) is named Book nnn which means it hasn't been saved before; this removes the need to reserve a timestamp cell in your workbook
Here are a couple of functions you could use to get your id. If you put this inside a vba module on your template you will be able to call the functions from the worksheets or other vba code (e.g. in workbook just enter '=get_id()', in vba you would do something like 'id = get_id()' to call this:
Option Explicit
Public Function lpad(string1, padded_length, _
Optional pad_string = " ")
Dim chars
chars = padded_length - Len(string1)
lpad = WorksheetFunction.Rept(pad_string, chars) & string1
End Function
Public Function get_id()
Dim user
Dim YYYYMMDD
Dim hhmmss
user = Environ("username")
YYYYMMDD = Year(Now()) & lpad(Month(Now()), 2, 0) & lpad(Day(Now()), 2, 0)
hhmmss = lpad(Hour(Now()), 2, 0) & lpad(Minute(Now()), 2, 0) & lpad(Second(Now()), 2, 0)
get_id = user & "-" & YYYYMMDD & "-" & hhmmss
End Function
The lpad function is just for formatting (so that you get 07 for July instead of 7 etc.). I have also added something here to set the user to the windows environment variable for the current user's name, but if you want to promt the user instead this part could easily be replaced.
Let me know if you have any questions.
I am having a problem with the Format() function in excel vba. I am trying to alter the formatting of a date formatted cell to change the way it is displayed. However, everytime i invoke Format to do that i get the error: "Compile Error: Wrong number of arguments or invalid property assignment."
here is the code:
Sub test()
Dim given
given = DateSerial(2012, 10, 11)
dateformat = Format(given, "dd/mm/yy")
MsgBox given & vbCrLf & dateformat
End Sub
This is just a test function and should function on its own and return "11/10/12". This code works on other computers. What could be wrong?
Had this problem with code I put in a Worksheet_Activate() today and was pulling my hair out. Resolved it by changing Format to VBA.Format
So try:
Sub test()
Dim given
given = DateSerial(2012, 10, 11)
dateformat = VBA.Format(given, "dd/mm/yy")
MsgBox given & vbCrLf & dateformat
End Sub
This is because you might also have some Sub named Format somewhere else in your project.Hence you get the error.
Currently you are declaring your given variable as a variant by default. Please declare it as Date data type. And to be safe, make sure you only send a Date using CDate() into the Format() to format as the date style you want.
Also DateSerial input should be in the following format. Which in your case alright. ;)
DateSerial(CInt(x), CInt(y), CInt(z)
Code snippet:
OPTION EXPLICIT '------------ please add this to your code to begin for better coding
Sub test()
Dim given as Date '-------- define given as Date type
Dim dateformat as Date
given = DateSerial(2012, 10, 11)
dateformat = Format(CDate(given), "dd/mm/yy") '--------- anyway wrap with CDate() to be sure
MsgBox given & vbCrLf & dateformat
End Sub