I want date & time to be updated in cell J40 when i add text in adjacent cell I40. In same sheet already in another cell C40 i have used macro to update date & time when i add text in E40. Tried copy pasting same macro and changing cell numbers but did not work. Please provide any solution. Even excel formula can do.
macro '''
Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("F470:F1200"), Target)
xOffsetColumn = -3
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Sub Worksheet_Change_1(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("I470:I1200"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub''''
Related
As the question suggests, I need a textbox to only allow one decimal point in it, less than three numbers before it, and only one number after it.
I've compiled this code so far.
Private Sub TextBox14_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox14.KeyPress
Dim keyChar = e.KeyChar
If Char.IsControl(keyChar) Then
'Allow all control characters.
ElseIf Char.IsDigit(keyChar) OrElse keyChar = "."c Then
Dim text = Me.TextBox14.Text
Dim selectionStart = Me.TextBox14.SelectionStart
Dim selectionLength = Me.TextBox14.SelectionLength
text = text.Substring(0, selectionStart) & keyChar & text.Substring(selectionStart + selectionLength)
If Integer.TryParse(text, New Integer) AndAlso text.Length > 3 Then
'Reject an integer that is longer than 16 digits.
e.Handled = True
ElseIf Double.TryParse(text, New Double) AndAlso text.IndexOf("."c) < text.Length - 3 Then
'Reject a real number with two many decimal places.
e.Handled = True
End If
Else
'Reject all other characters.
e.Handled = True
End If
End Sub
The biggest issue I'm getting is that the user can put in multiple decimal points and then basically all the rules I created go away. Additionally, the user is not able to set 2 numbers before the decimal point when I want them to.
Solved it using my head.
Private Sub TextBox11_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox11.KeyPress
'What is allowed to be typed in sale price textbox
Dim keyChar = e.KeyChar
If Char.IsControl(keyChar) Then
'Allow all control characters.
ElseIf Char.IsDigit(keyChar) OrElse keyChar = "."c Then
Dim text = Me.TextBox11.Text
Dim selectionStart = Me.TextBox11.SelectionStart
Dim selectionLength = Me.TextBox11.SelectionLength
text = text.Substring(0, selectionStart) & keyChar & text.Substring(selectionStart + selectionLength)
If TextBox11.Text.Contains("."c) Then
'Forbids a user from entering in two decimal places
If keyChar = "."c Then
e.Handled = True
ElseIf text.Length - text.IndexOf("."c) > 3 Then
e.Handled = True
End If
Else 'no decimal point currently in textbox
If text.Length > 5 And keyChar = ("."c) Then 'Allows only a "." to be written
e.Handled = False
ElseIf text.Length > 5 Then ' Numbers before decimal point above 99,999
e.Handled = True
End If
End If
Else
'Reject all other characters for this textbox.
e.Handled = True
End If
End Sub
I have a recursive function that creates a list of items based on their hierarchy(integer is used to determine which level 1 to 10 max). There can be x number of items in any given level. I want to store all the items that belong the same level at the corresponding index of the jagged array. The items aren't retrieved based on their level so the level can be jumping around all of over the place as the function recurses.
Function RecurseParts(lngPartID1, lngLevel) As Object
'this function will recursivley print the parts lists for the part ID passed in
If IsNumeric(lngPartID1 & "") Then
Dim objRSTemp As Object = Server.CreateObject("ADODB.Recordset")
objRSTemp.CursorLocation = adUseClient
objRSTemp.Open(PART_LIST_SQL & lngPartID1, objConn, adOpenForwardOnly, adLockReadOnly)
'objRSTemp.ActiveConnection = Nothing
If objRSTemp.eof And objRSTemp.bof Then
'PROBLEM, WE HAVE NO RECORDS
Response.Write("There Were No Parts For This Assembly (Part ID #:" & lngPartID1 & ")")
Else
'make output
Dim strTemp As String = String.Empty
If lngLevel <> 1 Then strTemp = " style=""display: none;"">"
Response.Write("<table id='tblparts" & lngCurrentLineNum & "' border=""0"" cellspacing=""0"" width=""100%"" cellpadding=""1"" " & strTemp)
Do Until objRSTemp.EOF
'increase the current line num
lngCurrentLineNum = lngCurrentLineNum + 1
'get current Part ID
lngCurrentPartID = objRSTemp("PartID").value
'reset flag
blnIsAssm = False
'loop thru array of assemblies to see if this is a parent
For ctr = 0 To UBound(arrAssmList, 2)
If arrAssmList(0, ctr) = lngCurrentPartID Then
'the current part is an assembly
blnIsAssm = True
Exit For
ElseIf arrAssmList(0, ctr) > lngCurrentPartID Then
Exit For
End If
Next
If blnIsAssm Then
'recurse these parts
If RecurseParts(objRSTemp("PartID").value, lngLevel + 1) = True Then
'awesome
End If
End If
objRSTemp.MoveNext()
Loop
Response.Write("</table>")
End If
If objRSTemp.State Then objRSTemp.Close()
objRSTemp = Nothing
'RETURN FUNCTION
RecurseParts = True
Else
'no PART ID passed in
Response.Write("No Part ID Passed In")
RecurseParts = False
End If
End Function
It sounds like a Dictionary would work here.
Dim myDict As New Dictionary(Of Integer, List(Of String))
In your recursive function. The parts in the {} are the parts you have to supply.
'this builds the keys as you go
If Not myDict.ContainsKey({{key} -> your Integer}) Then
'add key and use the From statement to add a value if know at this time
myDict.Add({key}, New List(Of String) From {value})
Else
myDict({key}).Add({string to insert at this level})
End If
List of keys in reverse order:
Dim keys = myDict.Keys.OrderByDescending(Function(k) k)
I was able to create a List to store all the partIDs and their levels.
Dim arrSubID As New List(Of List(Of Integer))()
Function RecurseParts(paramenters)
For ctr = 0 To UBound(arrAssmList, 2)
If arrAssmList(0, ctr) = lngCurrentPartID Then
'checks whether we need a new index in the list
If lngLevel + 1 > arrSubID.Count Then
arrSubID.Add(New List(Of Integer))
End If
'adds the partID where it belongs!
arrSubID(lngLevel).Add(lngCurrentPartID)
blnIsAssm = True
Exit For
ElseIf arrAssmList(0, ctr) > lngCurrentPartID Then
Exit For
End If
Next
End Function
Sorry again, experts for the bother again.but
We have a db date called orderdate.
If today's date - orderdate is less than 2 days (or 48 hours), disable Cancel Order button so user cannot cancel his or her order.
When I tried running the following code, I get Input string not in the format
Orderdate is of type datetime. However, we would like to display the date in the format of MM/dd/yyyy. Example: 6/4/2013, not 06/04/2013.
Can you please look at my code and tell me what I am doing wrong?
If dr1.Read() Then
Dim odate As String = DateTime.Parse(dr1("orderDates").ToString()).ToShortDateString()
Dim cancelBtn As New Button()
Dim dates As String = DateTime.Parse(Now().ToString()).ToShortDateString()
If (sdate - dates) <2 Then
cancelBtn.Enabled = False
Else
cancelBtn.Enabled = True
End If
End If
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As GridViewRowEventArgs)
' Create cancel training button
Dim cancelBtn As New Button()
cancelBtn.Style.Add("width", "105px")
cancelBtn.Style.Add("padding", "5px")
cancelBtn.Style.Add("margin", "5px")
'cancelBtn.Enabled = False
cancelBtn.Text = "Cancel training"
If e.Row.RowIndex > "-1" Then
' Change tracking ID to link
'Dim track As [String] = e.Row.Cells(4).Text
'If track <> " " AndAlso track.Length > 0 Then
' Dim trackLink As New Literal()
' trackLink.Text = "<a style='color: blue;' href='" + track + "'/>Track</a>"
' e.Row.Cells(4).Controls.Add(trackLink)
'End If
' Add buttons to column
Dim oid As [String] = e.Row.Cells(0).Text
Dim invoiceLink As New Literal()
invoiceLink.Text = "<a style='color: blue;' href='Invoice.aspx?oid=" + oid + "'/>" + oid + "</a>"
e.Row.Cells(0).Controls.Add(invoiceLink)
e.Row.Cells(e.Row.Cells.Count - 1).Controls.Add(cancelBtn)
' Pass order id & row to on-click event
'cancelBtn.Click += new EventHandler(this.cancelBtn_Click);
'cancelBtn.CommandArgument = e.Row.RowIndex + "-" + oid
End If
End Sub
I'm not sure why you'd want to convert your date fields into strings. I would recommend leaving those as datetime objects for your comparison. You can always manipulate the display of the dates in your presentation logic.
This is some working code leaving as dates using Subtract and TotalDays:
Dim cancelBtn As New Button()
Dim odate As DateTime = DateTime.Parse(dr1("orderDates").ToString())
Dim dates As DateTime = DateTime.Now()
If dates.Subtract(odate).TotalDays >= 2 Then
cancelBtn.Enabled = False
Else
cancelBtn.Enabled = True
End If
You could also consolidate the If statement to a single line:
cancelBtn.Enabled = dates.Subtract(odate).TotalDays < 2
EDIT: Regarding the logic, your DB field orderDates sounds like it refers to the day the order was created. That date will always be in the past, so we would be interested in Today - orderDates.
However, based on your comments it seems orderDates refers to the day the order will ship. That date must be more than 2 days in the future for the user to cancel his order, so we're interested in orderDates - Today.
I don't see where you run the order date logic inside GridView1_RowDataBound.
Private Function MoreThanTwoDaysUntilShip() As Boolean
'logic to open dr1
If dr1.Read() Then
Dim shipDate As Date = DateTime.Parse(dr1("orderDates").ToString())
Dim today As Date = Date.Now
Return shipDate.Subtract(today).TotalDays > 2
End If
Return False
End Function
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As GridViewRowEventArgs)
' Create cancel training button
Dim cancelBtn As New Button()
cancelBtn.Style.Add("width", "105px")
cancelBtn.Style.Add("padding", "5px")
cancelBtn.Style.Add("margin", "5px")
'add this
cancelBtn.Enabled = MoreThanTwoDaysUntilShip()
'etc
End Sub
DateTime.Parse(Now().ToString()).ToShortDateString()
Replace with
Today
And otherwise, don't manipulate dates in strings.
Im doing this project for an online test in ASP.NET in VB im using Microsoft visual studios 2012.
Im trying to get a loop going through my textboxes and check them against a word this will be change to be validated against a database to see if the answer are correct but when I do my loop I cannot get my text from the textbox.
Please see below
Private Sub GoGoGo()
Dim Textboxname As String '
Dim textbox As Object
Dim TextboxText As Object
Dim Labelname As String
Dim label As Object
Dim LabelText As Object
Dim Number As Integer = 1
Dim MaxTime As Integer = 9
Dim Currentloop As Integer = 1
For check As Integer = Currentloop To MaxTime
If Currentloop <= MaxTime Then
Textboxname = "TextQ" + Number
textbox = Textboxname
TextboxText = textbox
textbox.ReadOnly = True
End If
If Currentloop <= MaxTime Then
Labelname = "Label" + Number
label = Labelname
LabelText = label.Text
label.Visible = True
End If
Number = Number + 1
If TextboxText = "" Then
label.Text = "no imput"
label.ForeColor = Drawing.Color.Black
End If
If TextboxText = "server" Then
label.Text = "Correct"
label.ForeColor = Drawing.Color.Green
End If
If TextboxText = "Wrong" Then
label.Text = "Wrong"
label.ForeColor = Drawing.Color.Red
End If
If check = 9 Then
Exit For
End If
Next
End Sub
It looks like you are trying to use the string identifier of the control in place of the the actual control. Instead, you should take this identifier and search for the actual control on the page. You can do this using the FindControl method
Your function would therefore look something like (not compile tested):
Private Sub GoGoGo()
'
Dim oTextBox As TextBox
Dim oLabel As Label
Dim MaxTime As Integer = 9
Dim Currentloop As Integer = 1
For check As Integer = Currentloop To MaxTime
If Currentloop <= MaxTime Then
'NB You may have to use a recursive call to FindControl. See below.
oTextBox = CType(Page.FindControl("TextQ" & CStr(check)), TextBox)
OTextBox.ReadOnly = True;
End If
If Currentloop <= MaxTime Then
'NB You may have to use a recursive call to FindControl. See below.
oLabel = CType(Page.FindControl("Label" & CStr(check)), Label)
oLabel.Visible = True
End If
If oTextBox.Text = "" Then
oLabel.Text = "no imput"
oLabel.ForeColor = Drawing.Color.Black
End If
If oTextBox.Text = "server" Then
oLabel.Text = "Correct"
oLabel.ForeColor = Drawing.Color.Green
End If
If oTextBox.Text = "Wrong" Then
oLabel.Text = "Wrong"
oLabel.ForeColor = Drawing.Color.Red
End If
Next
End Sub
Some notes:
You don't need all of those variables. Instead, just find the actual controls, and interact with the properties directly - just check the TextBox.Text value when you need to, and set the Label.text property directly. The set is especially important as you want to update the original control property so it is shown on the page.
Similarly, you don't need Number - you can use check as this is your loop counting variable.
Whether you use the + operator or the & operator for string concatenation is up to you. There's already a good question and several answers here.
You also don't need the exit condition for the loop - the loop will exit as soon as you reach MaxTime. If you want it to exit early, just vary your To condition (e.g. Currentloop To MaxTime - 1)
UPDATE:
Page.FindControl will only work with controls that are immediate children of the root element on the page. Instead, you should try calling FindControl recursively. You should also make sure that a control with the id TextQ1 exists - look in the HTML source for the page on the client to make sure a TextBox with this id exists.
There are many examples of this on the net. Here's a VB.Net version (source: http://www.pavey.me/2007/09/recursive-pagefindcontrol-for-vbnet.html) that you can add to your page:
Public Function FindControlRecursive(Of ItemType)(ByVal Ctrl As Object, ByVal id As String) As ItemType
If String.Compare(Ctrl.ID, id, StringComparison.OrdinalIgnoreCase) = 0 AndAlso TypeOf Ctrl Is ItemType Then
Return CType(Ctrl, ItemType)
End If
For Each c As Control In Ctrl.Controls
Dim t As ItemType = FindControlRecursive(Of ItemType)(c, id)
If t IsNot Nothing Then
Return t
End If
Next
Return Nothing
End Function
Your line in the code above would then become:
oTextBox = FindControlRecursive(of TextBox)(Page.Controls(0), "TextQ" & CStr(check))
You'd also need to do the same for the Label control.
It Look like you are using only name istead of textbox try with the code below
Private Sub GoGoGo()
Dim Textboxname As String '
Dim textbox As TextBox
Dim TextboxText As Object
Dim Labelname As String
Dim label As Object
Dim LabelText As Object
Dim Number As Integer = 1
Dim MaxTime As Integer = 9
Dim Currentloop As Integer = 1
For check As Integer = Currentloop To MaxTime
If Currentloop <= MaxTime Then
Textboxname = "TextQ" + Number
textbox = Ctype(Me.Controls(Textboxname), TextBox)
TextboxText = textbox.Text
textbox.ReadOnly = True
End If
If Currentloop <= MaxTime Then
Labelname = "Label" + Number
label = Labelname
LabelText = label.Text
label.Visible = True
End If
Number = Number + 1
If TextboxText = "" Then
label.Text = "no imput"
label.ForeColor = Drawing.Color.Black
End If
If TextboxText = "server" Then
label.Text = "Correct"
label.ForeColor = Drawing.Color.Green
End If
If TextboxText = "Wrong" Then
label.Text = "Wrong"
label.ForeColor = Drawing.Color.Red
End If
If check = 9 Then
Exit For
End If
Next
End Sub
I can't get the text.contains("9999999") statement to return true. The column with index of 1 has ID#'s. These id's are anchor tagged and I need to remove the tags if the id number is 9999999. Everything else in the main if statement works correctly.
If e.Row.RowType = DataControlRowType.DataRow Then
lDate = e.Row.Cells(8).Text
e.Row.Cells(7).Text = ConvertDate(e.Row.Cells(7).Text, True)
e.Row.Cells(8).Text = ConvertDate(e.Row.Cells(8).Text, True)
If e.Row.Cells(1).Text.Contains("9999999") = True Then
Regex.Replace(e.Row.Cells(1).Text, "</?(a|A).*?>", "")
Dim yoasd As String = e.Row.Cells(1).Text
End If
If e.Row.Cells(8).Text.Trim = "" Or lDate < lToday Then
e.Row.BackColor = Drawing.Color.BurlyWood
End If
End If
I've also tried:
If e.Row.Cells(1).Text = "9999999"
If e.Row.Cells(1).Text.Trim = "9999999"
If e.Row.Cells(1).Text.Contains("9999999") Then
You could try this on your RowDataBound
If e.Row.RowType = DataControlRowType.DataRow Then
dim toberemoved as string = DataBinder.Eval(e.Row.DataItem, "ColumName")
if toberemoved = "9999999" then
Regex.Replace(e.Row.Cells(1).Text, "</?(a|A).*?>", "")
//Morestuff here
End If
End If
Remember to replace ColumName with the actuall name of the colum
*not tested built from memory.