I think I've tried literally everything including converting the Timestamp back into date using CDate
The code is a test I'm running to get the Range.Find to work in the first place. The file in which i look up the time stamp is formatted as special dd.mm.yyyy hh:mm for example 01.01.2019 00:00 whereas in the formula bar it is 01.01.2019 00:00:00
EDIT : Removed the quotes around sDate, a copy and paste mistake
Sub trial()
Dim r As Range
Dim sDate As String
Dim find As Range
Dim col As Long
Set r = ThisWorkbook.Worksheets("INPUT_WIND").Range("d11")
col = ThisWorkbook.Worksheets("INPUT_WIND").Range("d11").Column
sDate = Format(r.Offset(, -col + 2), "dd.mm.yyyy hh:mm")
Debug.Print sDate
Set find = Workbooks("FINO raw-010119-310819").Worksheets(1).Range("A:A").find(sDate, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, SearchFormat:=True)
If Not find Is Nothing Then
Debug.Print find.Offset(, 1)
Else
MsgBox "nicht gefunden"
End If
End Sub
Try this fix
Sub trial()
Dim r As Range
Dim sDate As String
Dim find As Range
Dim col As Long
Set r = Range("d11")
col = Range("d11").Column
sDate = r.Offset(, -col + 2)
Debug.Print sDate
Set find = Worksheets(1).Range("A:A").find(CDate(sDate), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, SearchFormat:=True)
If Not find Is Nothing Then
Debug.Print find.Offset(, 1)
Else
MsgBox "nicht gefunden"
End If
End Sub
Related
I have an issue, I thought would be a pretty simple one, but now can't handle it so I guess was wrong.
I have a UDF that calculates the average of exchange rates between 2 dates
Option Explicit
Public Function averageFromRange() As Double
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Exchange Rates")
Dim dateStart As Date: dateStart = sh.range("G1").Value
Dim dateEnd As Date: dateEnd = sh.range("G2").Value
Dim myRange As String
Dim rangeStart As range
Dim rangeEnd As range
Set rangeStart = sh.range("A:A").Find(What:=CStr(dateStart), LookAt:=xlWhole, LookIn:=xlValues).Offset(0, 1)
Set rangeEnd = sh.range("A:A").Find(What:=CStr(dateEnd), LookAt:=xlWhole, LookIn:=xlValues).Offset(0, 1)
If rangeStart Is Nothing Then
MsgBox ("Date " & dateStart & " out of range")
End If
If rangeEnd Is Nothing Then
MsgBox ("Date " & dateEnd & " out of range")
End If
If Not (rangeStart Is Nothing Or rangeEnd Is Nothing) Then
myRange = rangeStart.Address & ":" & rangeEnd.Address
averageFromRange = Application.WorksheetFunction.Average(range(myRange))
End If
End Function
Any change in the entire workbook (apart from the sheet in which the function is called) re-evaluates the function to #VALUE!. I tried both parametrizing the UDF to have these dates as input params, and activating the sheet. I have no other ideas how to handle this issue. Could you help me out?
The Function returns #VALUE! when any of the dateStart or dateEnd is not found in column [A:A] because of these lines:
Set rangeStart = sh.range("A:A").Find(What:=CStr(dateStart), LookAt:=xlWhole, LookIn:=xlValues).Offset(0, 1)
Set rangeEnd = sh.range("A:A").Find(What:=CStr(dateEnd), LookAt:=xlWhole, LookIn:=xlValues).Offset(0, 1)
Those lines are trying to set the Offset(0, 1) of Nothing (i.e. Find returns Nothing and the lines are still trying to return the Offset)
Solution: First find the Cell containing the Dates then if the dates are found, set the Offset range.
Also you may want the UDF be Volatile if Column [A:A] or the Dates (start & end) are updated by formulas.
Try this code:
Public Function averageFromRange() As Double
Dim dDateIni As Date, dDateEnd As Date
Dim rINI As Range, rEND As Range
Application.Volatile 'Comment this line is VOLATILE is not required
With ThisWorkbook.Worksheets("Exchange Rates")
dDateIni = .Range("G1").Value
dDateEnd = .Range("G2").Value
With .Columns(1)
Set rINI = .Find(What:=CStr(dDateIni), LookAt:=xlWhole, LookIn:=xlValues)
Set rEND = .Find(What:=CStr(dDateEnd), LookAt:=xlWhole, LookIn:=xlValues)
End With
End With
If rINI Is Nothing Then MsgBox ("Date " & dDateIni & " out of range")
If rEND Is Nothing Then MsgBox ("Date " & dDateEnd & " out of range")
If Not (rINI Is Nothing And rEND Is Nothing) Then
averageFromRange = Application.Average(Range(rINI.Offset(0, 1), rEND.Offset(0, 1)))
End If
End Function
Resources used:
Worksheet.Range,
With statement
I am trying to develop a Find button, to mark in red "ALL" of the word that are contained in a cell.
For example If I have in my cell this text.
"Pepper had peppermint in his pocket"
it should change to this.
"Pepper had peppermint in his pocket"
This code highlights the first word that it finds.
Dim i As Long
Dim oldrngrow As Long
Dim myValue As String
Dim arr() As Variant
arr = Array(TextBox1.Value)
TextBox2.Text = UBound(arr)
For i = 1 To UBound(arr) + 1
myValue = arr(i - 1)
If myValue = vbNullString Then
MsgBox ("Please Enter a Word in Textbox")
End
End If
Set rng = Cells.Find(What:=myValue, After:=Cells(1, i), LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, MatchByte:=True, SearchFormat:=False)
If rng Is Nothing Then
GoTo skip
End If
oldrngrow = rng.Row
Do While rng.Column = i
If ComboBox1.Text = "Red" Then
rng.Characters(InStr(rng, myValue), Len(myValue)).Font.ColorIndex = 3
Set rng = Cells.FindNext(After:=rng)
If oldrngrow = rng.Row Then
Exit Do
End If
Loop
skip:
Next i
Interesting question. After some research, I’ve put together the following code to demonstrate how to highlight every instance of a word in a string within a cell. For the sake of the demonstration, it uses an Input Box to get the desired string-to-highlight (you can change the method), and assumes the range to search is simply A1 – again you can change this to whatever you want.
Make sure you include Option Compare Text at the top of the Sub – otherwise the search will be case sensitive. Let me know how you go.
Option Compare Text
Sub StringColor()
Dim myRange As Range, myCell As Range, myString As String, myCount As Integer
Set myRange = Range("A1")
myString = InputBox("Type the word you want to color in A1")
For Each myCell In myRange
For myCount = 1 To Len(myCell) - Len(myString) + 1
If Mid(myCell, myCount, Len(myString)) = myString Then
myCell.Characters(myCount, Len(myString)).Font.Color = vbRed
End If
Next myCount
Next myCell
End Sub
Here's the relevant parts of my code I'm having trouble with.
Sub Find_Target()
Dim DayNum As Long
Dim TargetName As String
Dim TargetDay As Range
Dim found As Variant
DayNum = Cells(1, 9)
Set TargetDay = ActiveWorkbook.Sheets("3-2015").Range("A1:B440")
TargetDay.Activate
Set found = TargetDay.Find(DayNum, LookIn:=xlValues)
If found Is Nothing Then
MsgBox "Nothing found!"
Else
TargetDay.Select
End If
End Sub
Column A contains a mix of merged and unmerged cells. Cells(1, 9) contains a date in general format. Periodically in column A/B will be a merged cell containing that same number, but in custom number format "dddd". The find command works if I change the number format to general, but otherwise found is Nothing.
I've tried playing with the FindFormat option, but didn't have any luck there.
A bit unclear from the question, so I'm assuming that you have a number in cell I1 and you want to find the first cell with on the same day of the month. Assuming that's the case, you can just loop through the range and compare against the day directly:
Sub Find_Target()
Dim DayNum As Long
Dim TargetDay As Range
Dim found As Range
DayNum = Cells(1, 9)
Set TargetDay = ActiveWorkbook.Sheets("3-2015").Range("A1:B440")
Dim row As Long, col As Long
For row = 1 To TargetDay.Rows.Count
For col = 1 To TargetDay.Columns.Count
If IsDate(TargetDay.Cells(row, col).Value) Then
If Day(CDate(TargetDay.Cells(row, col).Value)) = DayNum Then
Set found = TargetDay.Cells(row, col)
Exit For
End If
End If
Next col
If Not found Is Nothing Then Exit For
Next row
If found Is Nothing Then
MsgBox "Nothing found!"
Else
found.Select
End If
End Sub
If I1 is something else, it should be trivial to modify - the key is explicitly treating the cell values as dates in VBA.
You need to .Find for LookAt:=xlFormulas and look for a Date type var, not a Long. Throw the following at your data.
Sub Find_Target()
Dim iDayNum As Long, sDayNum As String, dDayNum As Date
Dim foundI As Variant, foundS As Variant, foundD As Variant
Dim TargetDay As Range
iDayNum = Cells(1, 9)
sDayNum = Format(Cells(1, 9), "mm/dd/yyyy")
dDayNum = Cells(1, 9) 'I might even use CDate(Cells(1, 9).Value) as a reminder
Set TargetDay = ActiveWorkbook.Sheets("3-2015").Range("A1:B440")
Set foundI = TargetDay.Find(iDayNum, LookIn:=xlFormulas, LookAt:=xlWhole)
Set foundS = TargetDay.Find(sDayNum, LookIn:=xlFormulas, LookAt:=xlWhole)
Set foundD = TargetDay.Find(dDayNum, LookIn:=xlFormulas, LookAt:=xlWhole)
If foundI Is Nothing Then
MsgBox "As a Long - Nothing found!"
Else
MsgBox "As a Long - Found!"
End If
If foundS Is Nothing Then
MsgBox "As a String - Nothing found!"
Else
MsgBox "As a String - Found!"
End If
If foundD Is Nothing Then
MsgBox "As a Date - Nothing found!"
Else
MsgBox "As a Date - Found!"
End If
End Sub
You should have no problem finding the matching date var no matter whether it is formatted as dddd or anything else.
I would like to return the cell in which a date resides. There is one incidence of each date in column B, formatted dd/mm/yyyy. This is calculated from the cell two above (e.g. using =B3+7).
I have managed to retrieve the date using application.vlookup so I know it's "there". The immediate window gives the correct date using ? activecell.value
I cannot get the range.find function to return anything. If I enter a string with a USA date format such as 09/23/2014 into the column then range.find returns a value, but for UK formatted dates (=23/09/2014) it returns Nothing
Is the range.find function only capable of handling US dates?
Sub columnfind()
Dim DateRow, correctCell As Range
Set DateRow = ActiveSheet.Range("a1:B1000")
Dim strCurrentDate As String
Dim IntDate As Long
IntDate = CLng(CDbl(Now()))
strCurrentDate = Format(Now, "mm/dd/yyyy")
Set correctCell = DateRow.Find(IntDate, LookIn:=xlValues, lookat:=xlPart)
Set correctCell = DateRow.Find(strCurrentDate)
Set correctCell = DateRow.Find(Date)
cell = Application.VLookup(IntDate - 1, ActiveSheet.Range("B1:B1000"), 1, 1)'verify existence of date for my sanity
End Sub
. .
You can use something like:
Range("A1").Select
Application.FindFormat.Clear
Application.FindFormat.NumberFormat = "dd/mm/yy;#"
Set h = Range("A1:A4").Find("21/03", , , , , , , , True)
MsgBox h.Address
You define the format for the date, after use the bool SearchFormat option in the Find method.
If Find() does not work with certain formats, just don't use it:
Sub ColumnFind()
Dim bRng As Range, r As Range
Set bRng = Range("B1:B1000")
For Each r In bRng
If r.Text = "23/9/2014" Then
MsgBox r.Address(0, 0)
End If
Next r
End Sub
or
Sub ColumnFind()
Dim bRng As Range, r As Range
Dim sDate As String
sDate = Format(Date, "dd/m/yyyy")
Set bRng = Range("B1:B1000")
For Each r In bRng
If r.Text = sDate Then
MsgBox r.Address(0, 0)
End If
Next r
End Sub
This is my workaround now, if it is true that range.find doesn't work with non-US dates.
Sub columnfind()
Dim DateCol, correctCell As Range
Set DateCol = ActiveSheet.Range("B1:B1000")
Dim strCurrentDate As String
DateCol.NumberFormat = "mm/dd/yy;#"
strCurrentDate = Format(Now, "mm/dd/yy")
DateCol.Find(strCurrentDate).Select
DateCol.NumberFormat = "m/d/yyyy"
End Sub
I have some VBA experience, I can read and understand the coding, but have problems finding the proper codes.
Now, I have a userform where by the user would key in his ID, excel would then open up the database and search and return the results of the cells beside the found ID. the results would be returned and overwrite label 1 and label 2. And when the user clicks on the "next" or "previous" button, the next or previous results would then overwrite both labels.
The code I have right now allows me to search for the locations of the found ID and output the location in a format such as ($A$2,$A$3,$A$4,$A$6). The problem is that I am not sure what is the right functions that can then break this into individual range that the "next" or "previous" button can then refer to.
Have added my code
Dim cell As Range
Dim bcell As Range
Dim foundat As String
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
msgbox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = foundat
Exit Sub
You need to add two command buttons with name cmdNext & cmdPrev , label with name capproblem_output2 to run the below code. Copy the code to userform code section.
Public foundat As String
Private Sub cmdNext_Click()
capproblem_output.Caption = ActiveCell.Offset(1, 1)
capproblem_output2.Caption = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
End Sub
Private Sub cmdPrev_Click()
capproblem_output.Caption = ActiveCell.Offset(-1, 1)
capproblem_output2.Caption = ActiveCell.Offset(-1, 1)
ActiveCell.Offset(-1, 0).Select
End Sub
Private Sub CommandButton1_Click()
Main
End Sub
Sub Main()
Dim cell As Range
Dim bcell As Range
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = UserForm1.txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
MsgBox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = Range(foundat).Offset(0, 1)
capproblem_output2.Caption = Range(foundat).Offset(0, 1)
End Sub