Calculate the working hour - vb.net

I find it difficult to get the actual working hour and minute based on the Pay Amount and Pay rate per hour.
Example : working duration = (wages / pay per hour)
The following is my code. Please help.
strActDuration = CStr(Math.Round((dblActual / dblPayAmount), 1))
Dim parts As String() = strActDuration.Split("."c)
Dim strhour As Integer = 0
Dim strminutes As Integer = 0
If parts.Length = 1 Then
strhour = Integer.Parse(parts(0))
strminutes = 0
ElseIf parts.Length = 2 Then
strhour = Integer.Parse(parts(0))
strminutes = Integer.Parse(parts(1))
'strroundminutes = CInt(Math.Round(strminutes, 3))
'strroundminutes = CInt(Math.Truncate(strminutes / 10))
End If
strCombineDuration = strhour & "Hr " & strminutes & "Min"

Keep the duration as a number (double) and work in minutes; convert to Hours/Minutes using .NET formats:
dblMinutes = Math.Round(60*dblActual/dblPayAmount, 1)
Dim ts as TimeSpan = New Timespan(0, dblMinutes, 0)
strDuration = Format(ts.Hours, "0") & " Hr " & Format(ts.Minutes, "0")) & " Min"

Related

Visual Basic: how can I display certain values from a group of characters

Here we are finding the eight adjacent numbers that have the highest sum and displaying that sum. We also need to have it display the eight adjacent numbers that add up to this value. I am stuck on how to display these values. My code for what I have so far is below:
Dim chars As Char() = "73167176531330624919225119674426574742355349194934" &
"96983520312774506326239578318016984801869478851843" &
"85861560789112949495459501737958331952853208805511" &
"12540698747158523863050715693290963295227443043557" &
"66896648950445244523161731856403098711121722383113" &
"62229893423380308135336276614282806444486645238749" &
"30358907296290491560440772390713810515859307960866" &
"70172427121883998797908792274921901699720888093776" &
"65727333001053367881220235421809751254540594752243" &
"52584907711670556013604839586446706324415722155397" &
"53697817977846174064955149290862569321978468622482" &
"83972241375657056057490261407972968652414535100474" &
"82166370484403199890008895243450658541227588666881" &
"16427171479924442928230863465674813919123162824586" &
"17866458359124566529476545682848912883142607690042" &
"24219022671055626321111109370544217506941658960408" &
"07198403850962455444362981230987879927244284909188" &
"84580156166097919133875499200524063689912560717606" &
"05886116467109405077541002256983155200055935729725" &
"71636269561882670428252483600823257530420752963450"
Dim index As String = 0
Dim x = 0
Dim values = Array.ConvertAll(chars, Function(c) CInt(c.ToString()))
Dim maxSum = 0
For i = 0 To values.Length - 8
Dim sum = values(i)
For x = i + 1 To i + 7
sum += values(x)
index = i
Next
If sum > maxSum Then
maxSum = sum
End If
Next
Console.WriteLine(index)
Console.WriteLine(maxSum)
Console.Read()
End Sub
Here's my take on it using two different approaches. The first is a more traditional approach, while the second utilizes LINQ:
Sub Main()
Dim chunkSize As Integer = 8
Dim source As String =
"73167176531330624919225119674426574742355349194934" &
"96983520312774506326239578318016984801869478851843" &
"85861560789112949495459501737958331952853208805511" &
"12540698747158523863050715693290963295227443043557" &
"66896648950445244523161731856403098711121722383113" &
"62229893423380308135336276614282806444486645238749" &
"30358907296290491560440772390713810515859307960866" &
"70172427121883998797908792274921901699720888093776" &
"65727333001053367881220235421809751254540594752243" &
"52584907711670556013604839586446706324415722155397" &
"53697817977846174064955149290862569321978468622482" &
"83972241375657056057490261407972968652414535100474" &
"82166370484403199890008895243450658541227588666881" &
"16427171479924442928230863465674813919123162824586" &
"17866458359124566529476545682848912883142607690042" &
"24219022671055626321111109370544217506941658960408" &
"07198403850962455444362981230987879927244284909188" &
"84580156166097919133875499200524063689912560717606" &
"05886116467109405077541002256983155200055935729725" &
"71636269561882670428252483600823257530420752963450"
Dim strChunk As String
Dim strMaxChunk As String = ""
Dim curSum, MaxSum As Integer
Dim values() As Integer
For i As Integer = 0 To source.Length - chunkSize
strChunk = source.Substring(i, chunkSize)
values = Array.ConvertAll(strChunk.ToCharArray, Function(c) CInt(c.ToString()))
curSum = values.Sum
If curSum > MaxSum Then
MaxSum = curSum
strMaxChunk = strChunk
End If
Next
Console.WriteLine("Traditional")
Console.WriteLine("Max Sum = " & MaxSum & " from " & strMaxChunk)
Dim sums = From chunk In Enumerable.Range(0, source.Length - chunkSize).Select(Function(x) source.Substring(x, chunkSize))
Select chunk, sum = Array.ConvertAll(chunk.ToCharArray, Function(y) CInt(CStr(y))).Sum
Order By sum Descending
Dim linqResult = sums.First
Console.WriteLine("Linq")
Console.WriteLine("Max Sum = " & linqResult.sum & " from " & linqResult.chunk)
Console.ReadLine()
End Sub

Identify Paragraph content with certain outline level

I have a macro which pass through paragraphs of a word document. This code is intended to pass the paragraph, identify its outline level and retrieve the content when the desired paragraph outline level is found. With this information, I'm populating a listbox that will allow users to choose from what point they want to export some text in a document.
This functionality is working, however, I'm looking for a way to improve its speed. Right now I'm handling a document with 5678 paragraphs, and it is taking over 30 minutes to process all the information. Do you have any suggestion?
I had tried to approaches without having success:
1 - I've tried to use the object TableOfContents, however I was not able to have a clean information and differentiate outline levels from the paragraphs.
2 - I've tried to adapt the code from here Getting the headings from a Word document, specially because of the use of the command _docSource.GetCrossReferenceItems(wdRefTypeHeading), also with no success
Here there is the image of the form, and the code I'm using.
Sub ProcessHeaders()
Dim j As Long
Dim Paragraph_Number() As Variant
Dim Paragraph_Content() As Variant
Dim Paragraph_Mapping() As Variant
j = 1
With UserForm1
If .ComboBox4.ListCount > 0 Then
.ComboBox4.Clear
End If
For i = 1 To wordDoc.Paragraphs.Count
If wordDoc.Paragraphs.Item(i).OutlineLevel = wdOutlineLevel1 _
Or wordDoc.Paragraphs.Item(i).OutlineLevel = wdOutlineLevel2 _
Or wordDoc.Paragraphs.Item(i).OutlineLevel = wdOutlineLevel3 _
Or wordDoc.Paragraphs.Item(i).OutlineLevel = wdOutlineLevel4 Then
If wordDoc.Paragraphs.Item(i).Range.ListFormat.ListString <> "" Then
ReDim Preserve Paragraph_Number(j)
ReDim Preserve Paragraph_Content(j)
Paragraph_Content(j) = wordDoc.Paragraphs.Item(i).Range.ListFormat.ListString & " " & Trim(Left(wordDoc.Paragraphs.Item(i).Range.Text, (Len(wordDoc.Paragraphs.Item(i).Range.Text) - 1)))
Paragraph_Number(j) = i
j = j + 1
End If
End If
Next i
ReDim Preserve Paragraph_Mapping(1 To UBound(Paragraph_Content), 1)
For i = 1 To UBound(Paragraph_Number)
Paragraph_Mapping(i, 0) = Paragraph_Content(i)
Paragraph_Mapping(i, 1) = Paragraph_Number(i)
Next i
.ComboBox4.List = Paragraph_Mapping
End With
End Sub
Edit 1 - I Achieve to reduce the time from 32 minutes to 8 minutes of execution with the code below. Any suggestions to improve even more? Thanks in advance
Sub ProcessHeaders()
Dim j As Long
Dim thisOutlineLevel As WdOutlineLevel
Dim thisHeader As String
Dim thisList As String
Dim ParagraphCount As Long
Dim Paragraph_Number_Base() As Variant
Dim Paragraph_Content_Base() As Variant
Dim Paragraph_ListItem_Base() As Variant
Dim ParagraphContent() As Variant
Dim ParagraphNumber() As Variant
Dim Paragraph_Mapping() As Variant
Dim StartTime As Double
Dim MinutesElapsed As String
j = 1
With UserForm1
If .ComboBox4.ListCount > 0 Then
.ComboBox4.Clear
End If
ParagraphCount = wordDoc.Paragraphs.Count
ReDim Paragraph_Content_Base(ParagraphCount + 1)
ReDim Paragraph_ListItem_Base(ParagraphCount + 1)
ReDim Paragraph_Number_Base(ParagraphCount + 1)
StartTime = Timer
For i = 1 To ParagraphCount
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
UserForm1.Label7.Caption = "Reading Paragraphs. " & Format(i / ParagraphCount, "0%") & " | Total of Paragraphs Found: " & ParagraphCount & " | Time Elapsed: " _
& MinutesElapsed & " Minutes"
With wordDoc.Paragraphs.Item(i)
Select Case .OutlineLevel
Case wdOutlineLevelBodyText
GoTo ResumeNext
Case wdOutlineLevel1, wdOutlineLevel2, wdOutlineLevel3, wdOutlineLevel4
Paragraph_Content_Base(i) = .Range.Text
Paragraph_ListItem_Base(i) = .Range.ListFormat.ListString
Paragraph_Number_Base(i) = i
End Select
End With
ResumeNext:
Next i
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
UserForm1.Label7.Caption = ParagraphCount & " read on " & MinutesElapsed & " Minutes. Now, identifying the Headers"
For i = 0 To UBound(Paragraph_Content_Base)
If Paragraph_Content_Base(i) <> "" And Paragraph_ListItem_Base(i) <> "" Then
ReDim Preserve ParagraphContent(j)
ReDim Preserve ParagraphNumber(j)
ParagraphContent(j) = Trim(Paragraph_ListItem_Base(i)) & " " & Trim(Left(Paragraph_Content_Base(i), Len(Paragraph_Content_Base(i)) - 1))
ParagraphNumber(j) = Paragraph_Number_Base(i)
j = j + 1
End If
Next i
Erase Paragraph_Content_Base
Erase Paragraph_ListItem_Base
Erase Paragraph_Number_Base
ReDim Preserve Paragraph_Mapping(1 To UBound(ParagraphContent), 1)
For i = 1 To UBound(ParagraphNumber)
Paragraph_Mapping(i, 0) = ParagraphContent(i)
Paragraph_Mapping(i, 1) = ParagraphNumber(i)
Next i
.ComboBox4.List = Paragraph_Mapping
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
UserForm1.Label7.Caption = "Identifying Headers: " & j & " identified. Total Time: " & MinutesElapsed & " minutes"
End With
Edit 2 - With the Help of Cindy, the code which was initially running in 32 minutes right now is running on 32 seconds. Here is the final Code.
Sub ProcessHeaders()
Dim rng As Word.Range
Dim para As Word.Paragraph
Dim lstFormat As Word.ListFormat
Dim paraNr() As Variant
Dim paraContent() As Variant
Dim counter As Long, paraIndex As Long
Dim Paragraph_Mapping() As Variant
Dim ParagraphCount As Long
Dim i, j As Long
Dim StartTime As Double
Dim StartRealTime As Date
Dim MinutesElapsed As String
With UserForm1
If .ComboBox4.ListCount > 0 Then
.ComboBox4.Clear
End If
counter = 1
paraIndex = 1
i = 0
j = 1
StartTime = Timer
StartRealTime = Now
Set rng = wordDoc.Content
ParagraphCount = rng.ListParagraphs.Count
For Each para In rng.ListParagraphs
i = i + 1
Set lstFormat = para.Range.ListFormat
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
.Label7.Caption = "Reading Paragraphs. " & Format(i / ParagraphCount, "0%") & " | Total of Paragraphs Found: " & ParagraphCount & _
" | Start Time: " & StartRealTime & " | Time Elapsed: " & MinutesElapsed & " Minutes"
'CheckOutLine = rng.ListParagraphs.Item(1).OutlineLevel
If lstFormat.ListString <> "" And Len(lstFormat.ListString) >= 2 Then
ReDim Preserve paraNr(counter)
ReDim Preserve paraContent(counter)
paraContent(counter) = lstFormat.ListString & " " _
& Trim(Left(para.Range.Text, (Len(para.Range.Text) - 1)))
paraNr(counter) = i
wordDoc.Bookmarks.Add Name:="ExpContent" & i, Range:=para.Range
counter = counter + 1
End If
paraIndex = paraIndex + 1
Next
j = 1
ReDim Preserve Paragraph_Mapping(1 To UBound(paraNr), 1)
For i = UBound(paraNr) To 1 Step -1
Paragraph_Mapping(j, 0) = paraContent(i)
Paragraph_Mapping(j, 1) = paraNr(i)
j = j + 1
Next i
.ComboBox4.List = Paragraph_Mapping
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
.Label7.Caption = "Identifying Headers: " & j & " identified. Total Time: " & MinutesElapsed & " minutes"
End With
'
' For counter = 1 To UBound(paraNr)
' Debug.Print paraNr(counter) & vbTab & paraContent(counter)
' Next
End Sub
And After the user choose the paragraph, the bookmarks are being managed by this call
With objWord.Selection
BookmarkID = "ExpContent" & PositionReference
wordDoc.Bookmarks(BookmarkID).Select
.InsertParagraphBefore
End With
Once again, thank you
I think the fastest approach is going to be looping only the numbered paragraphs, rather than all paragraphs. This can be done using the ListParagraphs object. For example:
Sub IdOutlineLevels()
Dim rng As word.Range
Dim para As word.Paragraph
Dim lstFormat As word.ListFormat
Dim paraNr() As Variant
Dim paraContent() As Variant
Dim counter As Long, paraIndex As Long
counter = 1
paraIndex = 1
Set rng = ActiveDocument.content
For Each para In rng.ListParagraphs
Set lstFormat = para.Range.ListFormat
Select Case lstFormat.ListLevelNumber
Case 1, 2, 3, 4
If lstFormat.ListString <> "" Then
ReDim Preserve paraNr(counter)
ReDim Preserve paraContent(counter)
paraContent(counter) = lstFormat.ListString & " " _
& Trim(Left(para.Range.Text, (Len(para.Range.Text) - 1)))
paraNr(counter) = paraIndex
counter = counter + 1
ActiveDocument.Bookmarks.Add Name:="ExpContent" & counter, Range:=para.Range
End If
Case Else
End Select
paraIndex = paraIndex + 1
Next
For counter = 1 To UBound(paraNr)
Debug.Print paraNr(counter) & vbTab & paraContent(counter)
Next
End Sub
Rather than relying on the index number of the paragraph in the document to locate the paragraph again I've added bookmarks to each of the paragraphs using the same "counter" as the paragraph number. This is the technique Word, itself, uses for cross-referencing.

Read Each line not reading through entire file

I am using Vb to take a .txt file, parse it, and check for errors. My code works just fine, however, the code does not go through the entire file. It stops, on average, 20 lines shy of the EOF.
I am using the following
For Each lines As String In System.IO.File.ReadLines(myFile)
from here I parse the line and see if it needs any fixes.
Is there something that I'm missing or something that just cant be avoided.
The files that I'm reading in are about 150,000 KB to 230,000 KB and over 2 million lines.
As requested, the following is my code. Warning, I just started using Vb...
Module Module1
Sub Main()
Dim root As String = "C:\Users\mschramm\Documents\Agco\WindSensor\Data\filestobecleaned\"
Dim datafile As String = root & "ES.txt"
Dim outfile As String = root & "temptry.txt"
Dim output As System.IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(outfile, False)
Dim k As UInteger = 0
Dim fixes As UInteger = 0
Dim time As ULong = 0
Dim count As UInteger = 0
Dim n As UInteger = 0
Dim LineCount As UInteger = 0
Dim TimeStep As ULong = 100
Dim Solar As UInteger = 0
For Each lines As String In System.IO.File.ReadLines(datafile)
LineCount = LineCount + 1
'Console.WriteLine(LineCount)
Dim parsedline As String() = Split(lines, ",")
If IsNumeric(parsedline(0)) = True And UBound(parsedline) = 8 Then
'TimeStep = parsedline(0) - time
Solar = parsedline(1)
time = parsedline(0)
output.WriteLine(lines & " Good Line")
count = count + 1
Else
Dim j As UInteger = 0
Dim ETX As Integer = 0
Dim STX As Integer = 0
Dim datacheck As Boolean = False
Dim fixedline As String = ""
Dim newtime As ULong = 0
For j = 0 To UBound(parsedline)
Dim a As Char = parsedline(j)
If a = (Chr(3)) Then ETX = j
If a = (Chr(2)) Then STX = j
Next
j = 0
If (STX < ETX) And (ETX - STX) = 6 And STX >= 2 Then
If Len(parsedline(STX + 1)) = 8 And Len(parsedline(STX + 2)) = 8 And Len(parsedline(STX + 3)) = 8 Then
Dim g = Len(parsedline(STX - 2))
While (j < g) And datacheck = False
If IsNumeric(parsedline(STX - 2)) Then
If parsedline(STX - 2) - time < 10000 And parsedline(STX - 2) - time > 0 Then
newtime = Right(parsedline(STX - 2), Len(parsedline(STX - 2)))
Solar = parsedline(STX - 1)
'TimeStep = newtime - time
fixedline = newtime & "," & parsedline(STX - 1) & "," & parsedline(STX) & "," & parsedline(STX + 1) & "," & parsedline(STX + 2) & "," & parsedline(STX + 3) & "," & parsedline(STX + 4) & "," & parsedline(STX + 5) & "," & parsedline(STX + 6) & " Fixed Line"
datacheck = True
Else
j = j + 1
parsedline(STX - 2) = Right(parsedline(STX - 2), Len(parsedline(STX - 2)) - 1).ToString
End If
Else
j = j + 1
parsedline(STX - 2) = Right(parsedline(STX - 2), Len(parsedline(STX - 2)) - 1).ToString
End If
End While
End If
End If
If (STX < ETX) And (ETX - STX) = 6 And STX = 0 Then
If Len(parsedline(1)) = 8 And Len(parsedline(2)) = 8 And Len(parsedline(3)) = 8 And Len(parsedline(4)) = 1 And Len(parsedline(5)) = 2 And Len(parsedline(6)) = 3 Then
newtime = time + TimeStep
fixedline = newtime & "," & Solar & "," & parsedline(STX) & "," & parsedline(STX + 1) & "," & parsedline(STX + 2) & "," & parsedline(STX + 3) & "," & parsedline(STX + 4) & "," & parsedline(STX + 5) & "," & parsedline(STX + 6) & " Fixed Line Gave Time and Solar"
datacheck = True
End If
End If
If newtime < time And newtime > 1000 Then
Dim badtime As ULong = newtime
Dim firstdig As ULong = time
Dim loopcount As UInteger = 0
While firstdig > 9
firstdig = firstdig / 10
loopcount = loopcount + 1
End While
firstdig = firstdig * (10 ^ loopcount)
If (firstdig + badtime) > time Then
newtime = firstdig + badtime
If (newtime - (10 ^ loopcount)) > time Then
newtime = newtime - (10 ^ loopcount)
End If
End If
End If
If datacheck = True Then
k = k + 1
If (newtime > 500) Then
output.WriteLine(fixedline)
'count = count + 1
time = newtime
End If
End If
If datacheck = False Then
n = n + 1
If STX >= 0 And ETX > 0 And ETX - STX < 9 Then
Console.WriteLine(LineCount)
'n = n + 1
End If
End If
End If
Next
Console.WriteLine(count & " Good lines")
Console.WriteLine(k & " Lines Corrected")
Console.WriteLine(LineCount & " Total Lines")
Console.WriteLine(n & " Lines were thrown out")
Console.WriteLine(n / LineCount * 100 & "% thrown out")
End Sub
End Module
and here is a sample of the data
Time: 16:52:18.0
Date: 11/6/2014
Time,Sensor1,U,V,W
544161,219,Q,-001.341,+000.947,+000.140,M,00,17
544284,218,Q,-001.207,+001.074,+000.225,M,00,1C
544361,220,Q,-000.935,+000.898,+000.187,M,00,17
544460,220,Q,-001.299,+001.151,-000.009,M,00,17
This is what the last 10 lines look like
Q,+001.681,-003.510,-0356154697,236,Q,+000.826,-002.744,-000.559,M,00,19
Q,+000.474,-002.789,-0356155062,234,Q,+000.400,-002.975,+000.438,M,00,1D
Q,+000.813,-002.934,-0356155297,236,Q,+000.146,-002.129,-000.235,M,00,16
Q,+000.494,-002.234,+0356155497,236,Q,+000.681,-001.996,-000.248,M,00,1F
Q,+000.800,-001.999,-0356155697,236,Q,+001.181,-002.883,-000.795,M,00,1A
356156060,233,Q,+000.400,-002.106,+000.251,M,00,18
356156296,235,Q,+000.888,-001.026,+000.442,M,00,10
356156495,236,Q,+000.570,-001.694,+000.589,M,00,13
356156695,236,Q,+001.495,-002.177,-000.035,M,00,15
356157060,234,Q,+000.770,-003.484,-000.161,M,00,14
for this file, the code makes it to the 6th to last line.
Thanks to mafafu for pointing out the solution.
I never closed the file, so the addition of output.Close() fixed everything.
Once again, thank you mafafu.

Difference between "MM" standing for Months and "mm" standing for minutes when using Format function

My issue is that I am trying to set up a rolling count since our last accident at work. The code below works in a fashion. The rolling count works fine, but there is a problem with removing the "s" from the words (hours, minutes, seconds ect) with the Month and Minute.
Here's my code:
Sub LTI_Sub()
Static etime
'Exit Sub ' Uncomment to Stop
etime = Now() + TimeSerial(0, 0, 1)
Sheets("LTI").Range("Time") = LTI(Sheets("LTI").Range("Last"))
Application.OnTime etime, "LTI_Sub", , True
End Sub
Function LTI(LastLTI As Date)
x = Now() - LastLTI
Yx = Format(x, "yy")
If Yx = 1 Then
YS = ""
Else
YS = "s"
End If
Mx = Format(x, "mm")
If Mx = 1 Then
MS = ""
Else
MS = "s"
End If
Dx = Format(x, "DD")
If Dx = 1 Then
Ds = ""
Else
Ds = "s"
End If
Hx = Format(x, "HH")
If Hx = 1 Then
Hs = ""
Else
Hs = "s"
End If
MMx = Format(x, "MM")
If MMx = 1 Then
MMs = ""
Else
MMs = "s"
End If
Sx = Format(x, "SS")
If Sx = 1 Then
Ss = ""
Else
Ss = "s"
End If
LTI = Format(x, "YY \Y\e\a\r\" & YS & ", mm \M\o\n\t\h\" & MS & ", DD \D\a\y\" & Ds & "," & vbNewLine & "HH \H\o\u\r\" & Hs & ", MM \M\i\n\u\t\e\" & MMs & ", \A\n\d SS \S\e\c\o\n\d\" & Ss)
End Function
Now I'm not sure how VBA knows the difference between mm and MM when it comes to actually formatting the time, but on the lines where Mx and MMx are determined if the "s" is needed, it always treats it as a month value. How do I tell it to be minutes?
There's also a weird "fault" with the line x = Now() - LastLTI (where LastLTI is the date of the last accident). When returned in VBA it comes back with an extra month and day on it, but when done in Excel it returns the correct value. So for example, if it's been exactly 1 day since the lat accident (down to the second), VBA returns the following string: "00 Years, 01 Month, 02 Days, 00 Hours, 00 Minute , 00 Seconds" <-- Notice that the minutes has dropped the S because "Month" is equal to 1.
I hope this explains what I'm trying to achieve!
Thanks in advance
I use a few different date functions including DateDiff which returns the difference between two dates given to a specified interval, as well as DateAdd does the inverse of that by allowing you to add specified intervals to a date value. I also use the TimeValue function which returns only the time portion of the date.
I think this gets what you want, or at least should get you very very close.
Function LTI(LastLTI As Date)
Dim yx As Long
Dim mx As Long
Dim dx As Long
Dim hx As Long
Dim mmx As Long
Dim sx As Long
Dim ys As String
Dim ms As String
Dim ds As String
Dim hs As String
Dim mms As String
Dim ss As String
Dim dtNow As Date
dtNow = Now()
yx = DateDiff("yyyy", dtNow, LastLTI)
ys = IIf(yx = 1, "", "s")
mx = DateDiff("m", DateAdd("yyyy", yx, dtNow), LastLTI)
ms = IIf(mx = 1, "", "s")
dx = Format(dtNow - LastLTI, "dd")
ds = IIf(dx = 1, "", "s")
hx = DateDiff("h", TimeValue(dtNow), TimeValue(LastLTI))
hs = IIf(hx = 1, "", "s")
'compute the remaining minutes not allocated to a whole hour, above:
mmx = Format(TimeValue(dtNow), "n") - Format(TimeValue(LastLTI), "n")
mms = IIf(mmx = 1, "", "s")
' compute the remaining seconds not allocated to a whole minute, above:
sx = Format(TimeValue(dtNow), "ss") - Format(TimeValue(LastLTI), "ss")
ss = IIf(sx = 1, "", "s")
LTI = yx & "\Y\e\a\r\" & ys & ", " & _
mx & "\M\o\n\t\h\" & ms & ", " & _
dx & "\D\a\y\" & ds & "," & vbNewLine & _
hx & "\H\o\u\r\" & hs & ", " & _
mmx & "\M\i\n\u\t\e\" & mms & ", \A\n\d " & _
sx & "\S\e\c\o\n\d\" & ss
End Function
Instead of using Format (expression, "mm") for minutes, try Format (expression, "n").

string format using with increment

i have a ticket_no field which has a format of "storecode - datetoday - n" what i'm trying to is when as long as the date is today the "n" will just increment but if the date changes the "n" will reset to 1.
TMP_SQL = "select max(ticket_no) from tbl_main where store_id = '" + frm_store.store_code + "'"
Dim OBJCMD As New SqlCommand(TMP_SQL, OBJCON)
OBJREADER = OBJCMD.ExecuteReader()
Dim ydate As String
ydate = Now.ToString("MMddyy")
With OBJREADER
.Read()
Dim x As string
Dim str As String
If IsDBNull(OBJREADER(0)) = False Then
str = OBJREADER(0)
x = Int32.Parse(OBJREADER(0).ToString().Split("-")(1))
If x <> ydate Then
tmp = 0
tmp = Int32.Parse(OBJREADER(0).ToString().Split("-")(2)) + 1
Else
tmp = Int32.Parse(OBJREADER(0).ToString().Split("-")(2)) + 1
End If
End If
End With
txtTicketno.Text = frm_store.store_code & "-" & Now.ToString("MMddyy") & "-" & tmp