I have a column with value
09:00 - 21:00
Trying to find out how can I get the difference in hours, ie. for this example 12.
you can use this function
Function GetHourDifference(cell As Range) As Long
GetHourDifference = Hour(Split(cell.Value, "-")(1)) - Hour(Split(cell.Value, "-")(0))
End Function
to be exploited in your main code as follows
MsgBox GetHourDifference(Range("a1")) '<--| if cell "A1" has value "09:00 - 21:00" it returns: 12
If you are looking for a formula solution, i'd go with the following:
=HOUR(RIGHT(C24,5))-HOUR(LEFT(C24,5))
Which works as long as your values are always in the format provided.
If you are looking for a VBA solution I'd go with that of #user3598756
Option Explicit
Sub Macro1()
Dim txtDate As String
Dim i As Integer
Dim varDateDif As Variant, split1 As Variant, split2 As Variant
' Cell with times
txtDate = Range("A2").Value
' Split the cell using the delimiter -
varDateDif = Split(txtDate, "-")
For i = 0 To LBound(varDateDif)
split1 = varDateDif(i) ' First time
split2 = varDateDif(i + 1) ' Second time
Next i
' Difference in hours
Range("B2").Value = Abs(CDate(split1) - CDate(split2))
' Difference in minutes
Range("C2").Value = DateDiff("n", split1, split2)
End Sub
if your 09.00 - 21.00 is in cell B7, then this works:
=TIME(RIGHT(B7,5),RIGHT(B7,2),)-TIME(LEFT(B7,5),MID(B7,4,2),)
very brute force, as it assumes that the time is always 00.00 and no other characters will ever be included.
Related
I have a word table. I wrote a macro to get values from the table. When it runs I get a runtime error 13. When I debug and watch the value of parsing string it looks like this "2019-04-03 There is only one quote in the string. I think that is the case I couldn't convert that string into a date format. Can you help me to fix this?
The code
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
days = Selection.Tables(1).Rows(J).Cells(6).Range.Text
FormatDate = CDate(ends)
endDate = DateAdd("d", days, FormatDate)
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
The table
Here's the minimal change I found that works for me when tested in Word 2013.
General points:
I added Option Explicit so that the computer would help me find errors. In this case, the variables J and FormatDate were used but not Dimed, and ends was used but never initialized (I changed it to startDate).
The Range.Text in a table cell includes whitespace and the end-of-table marker (¤). That is why CDate was giving an error.
For the dates, I used Left() to take only the left ten characters, since you seem to always be using yyyy-mm-dd-format dates.
For the counts of days, since those can be of any length, I used Range.Words(1).Text to keep only the first Word (as MS Word defines it), which is the number.
I also added the CLng() call in the parameter to DateAdd, since DateAdd wants a number* rather than a string.
For production use, I would also recommend using Selection only in one place, and doing Dim workTable as Table: Set workTable = Selection.Tables(1). That will simplify your code.
Code
<=== marks changed lines
Option Explicit ' <==
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
Dim J As Long ' <==
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
startDate = Left(startDate, 10) ' <== Remove the space and table mark
days = Selection.Tables(1).Rows(J).Cells(6).Range.Words(1).Text ' <===
Dim FormatDate As Date ' <==
FormatDate = CDate(startDate) ' <== not `ends`
endDate = DateAdd("d", CLng(days), FormatDate) ' <=== clng
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
* DateAdd actually takes a Double, but VBA can promote Long to Double. I chose CLng since it looks like you are only using integer day spans. If not, use CDbl instead.
Try:
Sub Demo()
Dim r As Long
With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For r = 2 To .Rows.Count
.Cell(r, 7).Range.Text = _
Format(DateAdd("d", Split(.Cell(r, 6).Range.Text, vbCr)(0), CDate(Split(.Cell(r, 5).Range.Text, vbCr)(0))), "YYYY-MM-DD")
Next r
End With
End With
End Sub
I'm using the following function to find out whether values of two cells are in two columns.
I have to compare 250 sets of two-cells with 6500 sets of two-cells.
Excel spent 30 seconds to caculate the result.
Could I improve the calculation efficiency?
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim result As String
result = "False"
For n = 1 To twoCols.Rows.Count
If twoCols(n, 1) = "" Then
Exit For
End If
If twoCells(1, 1) = twoCols(n, 1) And twoCells(1, 2) = twoCols(n, 2) Then
result = "True"
Exit For
End If
Next
CompareWithTwoCells = result
End Function
here's a first step of possible enhancements (explanations in comments):
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim cell As Range
Dim firstVal As Variant, secondVal As Variant
firstVal = twoCells(1, 1) ' store first cell value in a variable
secondVal = twoCells(1, 2) ' store second cell value in a variable
CompareWithTwoCells = "False"
For Each cell In twoCols.Columns(1).SpecialCells(xlCellTypeConstants) ' loop through first column not empty values
If firstVal = cell.Value2 Then ' check one column fisrt
If secondVal = cell.Offset(, 1) Then ' check second column only if first columns check is true
CompareWithTwoCells = "True"
Exit For
End If
End If
Next
End Function
a further significant enhancement would use array instead of ranges
Is there a reason you can't just use MATCH=MATCH? (assuming twoCells is A1:B1 and twoCols is F1:G6500)
=IFERROR(MATCH(A1,$F$1:$F$6500,0)=MATCH(B1,$G$1:$G$6500,0),FALSE)
This is almost instant on my machine.
As per #Zac's suggestion, add:
Dim twoCellsArr, twoColsArr
twoCellsArr = twoCells.Value2
twoColsArr = twoCols.Value2
Then change your twoCells and twoCols to twoCellsArr and twoColsArr.
If your twoCols doesn't change and you're doing repeated comparisons i recommend using a Dictionary to store the twoCols.Value as keys and the row number as values, then perform the lookup and comparing whether they are in the same row.
I need to create a lot number which consists of:
Digits: 1,2,3 ----> Three digit reagent code ----> For example:141 (this is a constant)
Digit: 4 ----> Identifier ----> For example: 2 (this is a constant)
Digits: 5,6,7 ----> Julian/Ordinal Calendar day ----> 001-365 (366 for leap year)
Digit: 8 ----> The last digit of the expiry year ----> 0-9
Therefore: 14120039 (Expiry date would be 2019-01-03)
The expiry date can be found on a sheet called "CP_sequencer" in cell "S7". This will be in the format yyyy-mm-dd.
The following is the code I’m using so far but I know something is wrong and it may not be the most efficient way of doing things. There are a few cell references that are correct but I know it may be hard to follow without the actual spreadsheet.
Dim Julian_Day As String
Dim Split_Date As String
Dim valueYear, valueLastDigit As Integer
Range("F31").Select
Julian_Day = _
ActiveCell.FormulaR1C1 = _
"=VALUE(RIGHT(YEAR('CP sequencer'!R[-24]C[13]),2)&TEXT('CP sequencer'!R[-24]C[13]-DATE(YEAR('CP sequencer'!R[-24]C[13]),1,0),""000""))"
Split_Date = _
Range("F31") = Year(CP_Sequencer.Range("S7"))
Range("F31").Select
Select Case Len(value1) 'gives a number depending on the length of the value1
Case 4 ' e.g., 2017 = 201, 7
valueYear = Left(value1, 3) ' 201
valueLastDigit = Right(value1, 7) ' 7
End Select
ActiveCell.Value = "1412" & Julian_Day & valueLastDigit
I know something isn't right because at the moment when I run this code the output is 1412False0
Any help would be much appreciated
I assume you want a VBA solution to write back your lot number code to a given cell. Your code includes many errors (references without values, undeclared variables, double assignments and so on). Maybe the code with explainations below will be of some help. I use a type Definition to structure your results and make the code more readable.
Code
Option Explicit ' obliges you to declare your variables
Type TData ' declaration head of your module
ReagentCode As String ' 3 dig .. 141
ID As String ' 1 dig .. 2
JulDays As String ' 3 dig .. 1-365/366
YearDigit As String ' 1 dig .. 7 (2017 -> 7)
End Type
Sub CreateLotNo()
' Declare variables
Dim MyData As TData
Dim yr As Integer ' expiry year extracted from cell Sz
Dim ws As Worksheet
' set fully qualified reference to your worksheet
Set ws = ThisWorkbook.Worksheets("CP Sequencer")
' get expiry year from cell S7
yr = Year(ws.Range("S7").Value) ' expiry year
With MyData
' assign values to MyData
.ReagentCode = "141" ' constant
.ID = "2" ' constant
' julian days = expiry date minus last year's ultimo date
.JulDays = Format(ws.Range("S7").Value - CDate("12.31." & yr - 1), "000")
.YearDigit = Right(yr, 1) ' last digit of the expiry year
' write lot number back to cell XY
ws.Range("F31").Value = .ReagentCode & .ID & .JulDays & .YearDigit & ""
End With
End Sub
This should return the LotNumber you're after.
I'm quite not sure what's wrong with your code, but it will be in this line:
Julian_Day = _
ActiveCell.FormulaR1C1 = _
"=VALUE(RIGHT(YEAR('CP sequencer'!R[-24]C[13]),2)&TEXT('CP sequencer'!R[-24]C[13]-DATE(YEAR('CP sequencer'!R[-24]C[13]),1,0),""000""))"
This is asking the question is the formula in the activecell the same as the text string "=VALUE(RIGHT...." and place the result in the Julian_Day variable. Pretty much guaranteed that the value won't be the same so FALSE is returned.
If you wanted to get the result of the formula using that method you'd need to place the formula in the cell first and then read the result... but I'd advise against using that method. Easier to reference the values within VBA.
The LotNumber function below should return the value you're after. You can use it as I have in the Test procedure or as a worksheet function entered directly in a cell: =LotNumber(A1,B1,C1)
Sub Test()
'Passing values to the LotNumber function.
Debug.Print LotNumber(141, 2, DateValue("3 January 2019"))
'Getting values from Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Debug.Print LotNumber(.Range("A1"), .Range("B1"), .Range("C1"))
End With
End Sub
Public Function LotNumber(Reagent As Long, Identifier As Long, Expiry As Date) As String
Dim Ordinal As Long
Ordinal = Expiry - DateSerial(Year(Expiry), 1, 1) + 1
LotNumber = Format$(Reagent, "000") & Identifier & Format$(Ordinal, "000") & Right(Format(Expiry, "yyyy"), 1)
End Function
Edit:
As an afterthought you could define the LotNumber function as:
Public Function LotNumber(Expiry As Date, Optional Reagent As Long = 141, Optional Identifier As Long = 2) As String
Using this method you must pass the date to the function, but the Reagent and Identifier will default to 141 and 2 if no alternative values are supplied.
If entered today (30th November 17) then Debug.Print LotNumber(Date) will return 14123347. As a worksheet function with 3rd Jan 2019 in cell C1: =LotNumber(C1) will return 14120039
I have a data of some binary numbers in few range of cells, from A2 to A8, B2 to B8, and so on, till G column.
Now, I want to check the largest binary number from the above Rows and paste it to the cell, two row below the last used range. (i.e., Largest binary number from Row A to be paste in A10, and so on).
I am not finding any function which can find the value of binary numbers, and the code which I ran finds out the max number considering those as natural numbers.
Your help will be appreciated.
Thank You!
Okay first i made a function that converts binary to decimal and stored in a module. (You can store it wherever you want) This function handles any size binary
Function BinToDecConverter(BinaryString As String) As Variant
Dim i As Integer
For i = 0 To Len(BinaryString) - 1
BinToDecConverter = CDec(BinToDecConverter) + Val(Mid(BinaryString, Len(BinaryString) - i, 1)) * 2 ^ i
Next
End Function
Afterwards i made the sub that loops through all binarys on sheet1 (Might need to change this for your sheet)
Sub FindLargestBinary()
On Error Resume Next
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Application.ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim tempVal, tempRow As Integer
Dim iCoulmn, iRow As Integer
For iCoulmn = 1 To 7 'Run from A to G
tempRow = 2
tempVal = 0
For iRow = 2 To 8 'Run from row 2 to 8
If BinToDecConverter(ws.Cells(iRow, iCoulmn).Value) > tempVal Then tempVal = BinToDecConverter(ws.Cells(iRow, iCoulmn).Value): tempRow = iRow ' Check if current binary i higher then any previous
Next iRow
ws.Cells(iRow + 1, iCoulmn).Value = ws.Cells(tempRow, iCoulmn).Value 'Print highest binary
Next iCoulmn
End Sub
Hope this helps you out..
You can use the excel function Bin2Dec to change them into decimal
Function MaxBin(r as range)
Dim curmax as long
Dim s as range
For each s in r
If Application.WorksheetFunction.Bin2Dec(s.Text) > curmax Then curmax = Application.WorksheetFunction.Bin2Dec(s.Text)
Next s
MaxBin = curmax
End Function
Assuming your binary values are text strings this formula converts the values to numbers, finds the MAX and then converts back to a text string
=TEXT(MAX(A2:A8+0),"00000")
confirmed with CTRL+SHIFT+ENTER
or you can use this version which finds the max using AGGREGATE function and doesn't require "array entry"
=DEC2BIN(AGGREGATE(14,6,BIN2DEC(A2:A8+0),1))
I have a excel file.
I wish to write a Excel vba to compare the system time and the cell value time.
If system time is exceed the cell value time, it will show a pop out message to inform user that, the time is exceed.
My file will look like this:
I have been research a while but seem like only vba code will able to complete this requirement.
Sub TimeCheck()
Dim ValueTime As Date
Dim SysTime As Date
SysTime = Now()
Finalrow = Cells(Rows.Count, 14).End(xlUp).Row
'Column 14 stands for N, change as required
For I = 6 To Finalrow
'6 stands for first row filled with value, change as required
ValueTime = Cells(I, 14).Value
If TimeValue(ValueTime) < TimeValue(SysTime) Then
Cells(I, 14).Offset(, 1).Value = "Time is exceeeded" '1 is offsetting to column O. Use 2 for column P, 3 for Q and so on, as you prefer.
MsgBox ("Time is exceeeded for user entry in N" & I)
'To store the time error in adjacent O column cells, and to popup for each error
'Remove either as required - esp MsgBox, it is very annoying - put only because you asked in original question
End If
Next I
End Sub
If you want only advise the guest that the time input does not exceed the current, you don't need a vba (intersect will be one way) you can use the validate date
and you can customize the input msg and also the error msg if the value isn't correct.
Example
Sub TimeNow()
Dim cValue As Date '// Cell Value
Dim sTime As Date '// System
cValue = Sheets("Sheet1").Range("B2").Value
sTime = TimeValue(Now)
If sTime > cValue Then
MsgBox "TiMe iS Up. STOP " & TimeValue(Now)
Else: Exit Sub
'or do something
End If
End Sub
You can use the function TimeValue, which returns the value of time as a number between 0 and 1. Posting a simple code to check on cell N6 alone.
/// You may, of course, use loops to check for a range of cells, or use the excel events, or keyboard shortcuts to run the macro.///
Sub TimeCheck()
Dim ValueTime As Date
Dim SysTime As Date
ValueTime = Range("N6").Value
SysTime = Now()
If TimeValue(ValueTime) < TimeValue(SysTime) Then
MsgBox ("Time is exceeeded")
End If
End Sub