I am trying to parse sheet with time stamps and count number of occurrences.
my data have header (date, hour, instance, day), so I want to parse through days and when there is new day I record time (this is time of first event that day) and increment counter next to that "time" value (I add list of timestamps at column 11)
My code is:
Sub Count()
Dim i As Integer
Dim j As Integer
Dim Day As String
Dim Vrijeme As Date
Dim test As Date
For i = 1 To 5673
If Cells(i, 4).Value <> Day Then
Day = Cells(i, 4).Value
Vrijeme = Cells(i + 1, 2).Value
For j = 5 To 500
test = Cells(j, 11).Value
If Vrijeme = test Then // This is place that doesn t work
counter = Cells(j, 12).Value
counter = counter + 1
Cells(j, 12).Value = counter
End If
DoEvents
Next j
End If
Next i
End Sub
But this doesn t work, I event manualy set cell format to "Time" ... any idea why this doesn t work. when I do debug variable read data correctly but when it compare values this don t work ...
thx
try to use TimebValue and DateValue.
as
Day = DateValue(Cells(i, 4))
Vrijeme = TimeValue(Cells(i + 1, 2))
test = TimebValue (Cells(j, 11))
You need to compare comparable values, to be 100% sure that they are comparable convert them bout in one format.
Related
So I have this code below which looks at the B column for specific strings.
Based on the string result, the code will do some multiplication and place the result in either the J column or K column, depending on what string was found. My questions pertains to the first part of code where "supplier" is found. When the code performs the math it moves the result to the K column, for every "supplier" found in col B. I want it to also turn the text red, make it currency, and place the total underneath the data. How do I do this? Thank you very much for looking.
Sub SplitUp()
For i = 8 To 200
If cells(i, 2).Value = "supplier" Then
cells(i, 11) = cells(i, 13) * cells(i, 4)
Else
If cells(i, 2).Value = "manufacture" Then
cells(i, 10) = cells(i, 13) * cells(i, 4)
Else
End If
End If
Next i
End Sub
I have a button, which when clicked will give the current date and time in a text box.then I used another program to move that to cell.but this are not considered as the date until I double-clicked it.during filtering,this entered date are excluded from other dates
i have done formatting for date(ddmmyy HHmm)
Private Sub CommandButton5_Click()
If Not TextBox6.Value = "" Then
ans = msgbox(" Date already exits.Do you want to continue", vbYesNo + vbQuestion)
If ans = vbYes Then
TextBox6.Value = Format(Now(), ddmmyyHHmm)
End If
End If
If TextBox6.Value = "" Then
TextBox6.Value = Format(Now(), ddmmyyHHmm)
End If
End Sub
and for copying value to cell ,i used
cells(i,"A").value = textbox6.value
Format returns a Variant/String. You want to enter an actual date/time into the cell, not a formatted one that Excel no longer recognizes as a date.
One option is to use DateSerial and TimeSerial to build up a true date/time from that string. There's probably a simpler way to achieve this though, but anyway, here's an example:
Dim x As String
x = TextBox6.Value
Dim yy As Integer, dd As Integer, mm As Integer, hh As Integer, min As Integer
yy = CInt(Mid(x, 5, 2)) ' year
mm = CInt(Mid(x, 3, 2)) ' month
dd = CInt(Mid(x, 1, 2)) ' day
hh = CInt(Mid(x, 7, 2)) ' hour
min = CInt(Mid(x, 9, 2)) ' minute
Cells(i, "A").Value = DateSerial(yy, mm, dd) + TimeSerial(hh, min, 0)
If you want to format the cell with that date/time formatting:
Cells(i, "A").NumberFormat = "ddmmyyHHmm"
I would like to write to a cell the previous cells time value + 10 seconds.
I have tried several approaches after a lot of googling, however below is what I started with and what I would like to understand is why this doesn't work - as in my head it is logical.
The cell data is in the special format DD:MM:YYYY HH:MM:SS - which is a reason this may not work, however if I add + (10 / (3600 * 24)) to the cell manually then it successfully adds on 10 seconds.
Dates are stored as custom and show up as 24/09/2018 08:41:09.
Public Sub Add_Row()
Dim Row As Variant
Dim LR As Long
Dim x As Integer
Dim y As Integer
LR = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row 'Counts number of rows
x = 1
Row = 1
Do Until x = LR
If Cells(Row, 2).Value <= 1 Then 'If the value of the cell is less than or equal to one do nothing and increment
Row = Row + 1
x = x + 1
Else
y = Cells(Row, 2).Value - 1 'Need a variable for the number of rows we require based on how many missed points we have
For k = 1 To y
ActiveSheet.Rows(Row).Insert Shift:=xlDown
Cells(Row, 1).Value = Cells(Row - 1, 1).Value + (10 / (3600 * 24))
Next
Row = Row + y + 1
x = x + 1
End If
Loop
End Sub
MUltiplying 3600 by 24 in VBA will give an overflow error, because the max value of a 16 bit integer (the default type for the result when both the input numbers are integers) is 32767. You can either use a "#" which will tell VBA that you want to treat the result as a double, like so:
Cells(Row, 1).Value = Cells(Row - 1, 1).Value + (10 / (3600# * 24))
OR you can use "#12:00:10 AM#" which represents 10 seconds, rather than attempting to calculate it, like so:
Cells(Row, 1).Value = Cells(Row - 1, 1).Value + #12:00:10 AM#
Hope this helps.
I have a document with the following:
FullDateTime FullDate FullTime Day Month Year Hour Minute Second
dd/mm/yyyy hh:mm:ss AM/PM
and I would like to fill in the other columns using macros to split the first column and place the whole date, whole time, day, month, year, hour, minute and second in the other columns. FullDateTime is every five minutes and I want to the DateTime to run for a whole year. I imagine the code to look something like:
Sub Func()
Dim 5mindays as Integer = 12*24*365
Dim x As Integer
Dim date
Dim time
For x = 1 To 5mindays
Split(," ")
Split(,"/")
Split(,":")
.Offset(0,1) = date(0)
...
.Offset(0,8) = time(2)
Add the next FullDateTime field below the existing one (adding 5 minutes)
Next
But have no idea how to actually do it. Please give me some ideas on how to solve this. Thanks!
Try after setting the correct worksheet name and year to process,
Option Explicit
Sub funk()
Dim dt As Long, yr As Long, tm As Long, dttm As Double
yr = 2018
dt = DateSerial(yr, 1, 1)
With Worksheets("sheet6")
Do While Year(dt) = yr
Do While TimeSerial(0, tm * 5, 0) < 1
dttm = dt + TimeSerial(0, tm * 5, 0)
.Cells(tm + 1 + (dt - DateSerial(yr, 1, 1)) * 288, "A").Resize(1, 9) = _
Array(dttm, dt, dttm - dt, _
Day(dt), Month(dt), yr, _
Hour(dttm), Minute(dttm), 0)
tm = tm + 1
Loop
tm = 0
dt = dt + 1
Loop
With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "I").End(xlUp))
.Columns("A").NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
.Columns("B").NumberFormat = "dd/mm/yyyy"
.Columns("C").NumberFormat = "hh:mm:ss"
.Columns("D:I").NumberFormat = "0"
End With
End With
End Sub
I'm trying to speed up a COUNTIFS formula in a table I have.
The table is over 60k rows and the COUNTIFS has three conditions. The formula right now looks like this:
=IF(AND(COUNTIFS([Vessel],[#Vessel],[Date],">"&[#Date],[ETA],"<="&[#ETA]+20)=0,[#Arrived]=1,[#Sailed]=1,[#Date]<MAX([Date])),1,0)
The problem is that the calculation takes a very long time and it triggers everytime something change, even the filter. I don't want to turn calculations to manual in this sheet.
The purpose of the formula is to find the next occurence of the vessel in the line, the ETA can be slightly changed from day to day or the same ship can appear months later. I need to confirm if the vessel appears with the same ETA (or up to 20 days of difference) on another day.
Is there any other solution to this problem?
Maybe try building this as a macro instead, that way you would have control over when it executes.
Here is a start on a method for doing this. It gets the job done but breaks on an error on/after the last line is processed. Edit : Fixed and tested
Public Sub shipcheck()
Application.ScreenUpdating = False
Dim x As Long
Dim y As String
Dim counter As Long
For x = 2 To Range("A85536").End(xlUp).Row ' Assuming data has headers
y = Cells(x, 1) ' This assumes your vessel is in the first column
counter = x + 1
Do
If cells(counter,1) = "" Then Exit Do
If y = Cells(counter, 1) Then
If Cells(x, 2) <> Cells(counter, 2) Then 'This assumes your date is the second column
If DateDiff("d", Cells(x, 3), Cells(counter, 3)) > 20 Then ' this assumes ETA is your third column
Cells(x, 4) = 1 'This assumes the positive test is the fourth column
Cells(counter, 4) = 1
Exit Do
Else
End If
Else
End If
Else
End If
counter = counter + 1
Loop
Next x
Application.ScreenUpdating = True
End Sub