I want to find a date in a range, or rather part of a date. For example, I have the month and the year from a user input, stored in two variables userInputMonth and userInputYear, and would now like to find out in which row they appear.
Option Explicit
Sub CheckDate()
Dim wb As Workbook
Dim ws As Worksheet
Dim userInputYear As String
Dim userInputMonth As String
Dim rngDate As Range
Dim foundCell As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets(2)
userInputYear = Right(wb.Sheets(1).Range("A1").Value, 4) 'e.g. "2019"
userInputMonth = Mid(wb.Sheets(1).Range("A1").Value, 2, 2) 'e.g. "09"
Set rngDate = ws.Range("A3:A11")
Set foundCell = rngDate.Find("??." & userInputMonth & "." & userInputYear)
Debug.Print foundCell.Row '-> error
'=====Trying out stuff=====
Set foundCell = rngDate.Find(userInputMonth)
Debug.Print foundCell.Row 'works
Set foundCell = rngDate.Find(userInputMonth & ".")
Debug.Print foundCell.Row '-> error
Set foundCell = rngDate.Find("12.2019")
Debug.Print foundCell.Row '-> error
End Sub
I guess the format is the problem, but how do I deal with this, but I don't know how to apply something like CStr to this issue
edit: The data in rngDate looks like this: 31.12.2019 (formatted as date). A1 is text (e.g. A12 2019).
In my opinion you have to decide which type of data you want to manipulate. Do you prefer working with dates or strings ? After that choice, it will be easier to determine which operations will be necessary and which method or function will be applicable (you cannot do the same thing with dates or strings). Cheers
Related
I need a code to copy a range of cells (H21:H38) from my source worksheet (Acct Total) to a corresponding column on my target worksheet (COS% Tracking) based on matching headers. But the hiccup I have is that the header is in cell A6 on my source worksheet (Acct Total). I've researched it a bit and I've found this code that worked for someone else:
Sub CopyHeaders()
Dim header As Range, headers As Range
Set headers = Worksheets("ws1").Range("A1:Z1")
For Each header In headers
If GetHeaderColumn(header.Value) > 0 Then
Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))
End If
Next
End Sub
Function GetHeaderColumn(header As String) As Integer
Dim headers As Range
Set headers = Worksheets("ws2").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function
So my issue is that I don't know where to begin to edit this code to work like I need. This code worked by using the header above the range of cells but that won't do in my case. I'll attach pictures so that hopefully I'm not too vague.
Can someone help me to edit this code according to my needs?
Edit: Additional Picture for the source of the dates.
GL Code Tab
Look at the following construct as a starting point for a different way to solve the same problem. There are descriptive variables so you have an idea of what is happening.
Edit: As the target sheet row 3 is locked, code has been amended to use Match function to return column number where string is found (if found).
Essentially:
Set your source and target worksheets.
Set sourceWorksheet = wb.Sheets("Acct Total")
Set targetWorksheet = wb.Sheets("COS% Tracking")
Define your target value (the date you are trying to match on) and source range
targetDate = Trim$(sourceWorksheet.Range("A6"))
Set sourceRange = sourceWorksheet.Range("H21:H38")
Find the column number of where value (targetDate) is present in the target sheet
colNum = Application.WorksheetFunction.Match(targetDate, searchRange, 0)
Add error handling in case it is not present i.e. if date (as string) is not found....
ErrHand: 'code in this section.....
Set the address of where the target data will be pasted
Set targetRange = .Range(Cells(4, colNum), Cells(21, colNum))
Set the target range to be equal to the source range.
targetRange.Value = sourceRange.Value
Adapt as appropriate.
Putting it together you getting something along the lines of the following:
Option Explicit
Public Sub copydata()
Dim sourceRange As Range
Dim targetDate As String
Dim targetRange As Range
Dim wb As Workbook
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
Dim searchRange As Range
Set wb = ThisWorkbook
Set sourceWorksheet = wb.Sheets("Acct Total")
Set targetWorksheet = wb.Sheets("COS% Tracking")
targetDate = Trim$(sourceWorksheet.Range("A6"))
Set sourceRange = sourceWorksheet.Range("H21:H38")
Set searchRange = targetWorksheet.Rows(3)
On Error GoTo ErrHand
Dim colNum As Long
colNum = Application.WorksheetFunction.Match(targetDate, searchRange, 0)
With targetWorksheet
Set targetRange = .Range(Cells(4, colNum), Cells(21, colNum))
targetRange.Value = sourceRange.Value
End With
ErrHand:
If Err = 1004 Then
MsgBox "Not found: " & targetDate
Err.Clear
Exit Sub
End If
End Sub
See the following:
Finding address of text in worksheet
Moving data between sheets
I'm working on an Excel Spreadsheet that pulls a pick list from the SQL Database and populates the sheet. It then prompts the user to Scan a Part number. I am trying to locate the part number in Column A, and return the row for the part number.
The part number begins as a Variant type, but thinking that type was the problem, I converted it to string by setting its value to another variable.
Finally, I found this snippet of code (I've tried many and none have worked so far), and it works when you specify a number (123456789012) as in the code below. It does not work if you replace that number with the variable sPart nor scanPart.
I need it to work to find the row of the variable sPart (String) or scanPart (Variant). What am I doing wrong?
Function ReturnRowNumber()
Dim ws As Excel.Worksheet
Set ws = ActiveSheet
Dim scanPart As Variant
Dim sPart As String
Dim FoundRow As String
scanPart = InputBox("Scan the first part number", "Part Number") 'Get Part Number
sPart = scanPart
MsgBox sPart
Dim SearchRange As Range
Dim FindRow As Range
Set SearchRange = Range("A1", Range("A65536").End(xlUp))
Set FindRow = SearchRange.Find(123456789012#, LookIn:=xlValues, lookat:=xlWhole)
MsgBox FindRow.Row
End Function
Thanks in advance for any help!
Dana
The code as written in your post will NEVER work, as the syntax is not correct, especially in the .Find statement. Perhaps that issue was throwing you in the
wrong direction, thinking it was a data type issue.
Please see this code. Tested on both string and numerical values.
Option Explicit
Sub Test()
Dim sPart As String
sPart = InputBox("Scan the first part number", "Part Number") 'Get Part Number
MsgBox ReturnRowNumber(sPart)
End Sub
Function ReturnRowNumber(sPart As String) As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'be more explicit than 'ActiveSheet
Dim SearchRange As Range
Dim FindRow As Range
Set SearchRange = ws.Range("A1", ws.Range("A65536").End(xlUp))
Set FindRow = SearchRange.Find(sPart, LookIn:=xlValues, lookat:=xlWhole)
If Not FindRow Is Nothing Then ReturnRowNumber = FindRow.Row
End Function
From your code and the description of your problem it sounds like what is happening is you are defining a variable as Variant, but that Varian is really a String (thus, never use Variant unless you have a very specific reason to).
Something like:
Dim Foo as Variant
Dim Bar as Long
Foo = "123"
Bar = "123"
Is basically like saying:
Dim Foo as String
Dim Bar as Long
Foo = "123"
Bar = CLng("123")
The reason why this is important is because:
12345 <> "12345"
They are different values. One is a Long representation, the other is a String representation.
The solution to your problem? It depends on how your initial values are stored. If you are using String representations of your barcodes then you want to declare your barcode as a String, and use that String to search. It seems though that you are actually storing whole numbers, and if that is the case you will want to declare your barcode as a Long.
If, by some curse, you are storing Barcodes as Strings and as whole numbers, well you will either need to choose one or the other, or you will need to use a more robust find method (I recommend dictionaries).
Function ReturnRowNumber()
Dim ws As Excel.Worksheet
Set ws = ActiveSheet
Dim scanPart As Variant
Dim sPart As String
Dim FoundRow As String
Dim xlCell as Range
scanPart = InputBox("Scan the first part number", "Part Number") 'Get Part Number
sPart = scanPart
Dim SearchRange As Range
Dim FindRow As Range
Set SearchRange = Range(Range("A1"), Range("A1").End(xlDown))
Set xlCell = ActiveCell
Application.ScreenUpdating = False
SearchRange.Select
Set FindRow = SearchRange.Find(What:=sPart, After:=ActiveCell, SearchOrder:=xlByRows)
xlCell.Select
Application.ScreenUpdating = True
MsgBox FindRow.Row
End Function
It looks like your find function was not formatted properly. The code above works perfectly for me
I'm new to Excel VBA and was looking for some help in fixing my code. So basically to provide colour on what I have, I have an excel database, and a word document. In the word document I have bookmarked section headers (reffered to as "cat", "dog", and "bird") and in a row on the excel database I have "dog" and "bird".
What I am trying to do is write a code that compares the elements of the array (which are strings) to the cell values within a range declared in an excel database. For the values that exist in the array but not in the declared excel range, I want to delete those values (i.e. the bookmark) from the word document.
If anyone could provide me with feedback, ideas, or example codes it would be greatly appreciated.
Thanks.
Sub ArrayToDatabase()
Dim myRange As Variant
Set myRange = Range("C7:AP7")
Dim myArray As Variant
myArray = Array("cat", "dog", "bird")
Dim i As Integer
Dim reqName As Object
For i = LBound(myArray) To UBound(myArray)
Set reqName = myArray(i).Value
If myRange.Validation(reqName) = False Then
wdApp.ActiveDocument.Bookmarks(reqName).Range._
Paragraphs(1).Range.Delete
End If
Next i
End Sub
Logic
Use .Find to check if the keywords are present in the range or not.
Store the relevant keywords in a comma delimited string which will later be converted into an array
Open word doc
Loop through the array and delete the bookmarks
Is this what you are trying?
Option Explicit
Sub Sample()
Dim myArray As Variant, BookMarksToDelete As Variant
Dim oWordApp As Object, oWordDoc As Object
Dim sTemp As String, FlName As String
Dim aCell As Range, myRange As Range
Dim i As Long
'~~> Change this to the relevant sheet
Set myRange = ThisWorkbook.Sheets("Sheet1").Range("C7:AP7")
myArray = Array("cat", "dog", "bird")
'~~> Change this to the relevant word document
FlName = "C:\Users\Siddharth\Desktop\DeleteMeLater.docx"
For i = LBound(myArray) To UBound(myArray)
'~~> Check if the word exists in the range or not
Set aCell = myRange.Find(What:=myArray(i), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'~~> If it doesn't then store it in a comma delimited string
If aCell Is Nothing Then
sTemp = sTemp & "," & myArray(i)
Else
Set aCell = Nothing
End If
Next i
sTemp = Mid(sTemp, 2)
If Not Len(Trim(sTemp)) = 0 Then
'~~> Convert comma delimited string to array
BookMarksToDelete = Split(sTemp, ",")
'~~> Open word document
Set oWordApp = CreateObject("Word.Application")
oWordApp.Visible = True
Set oWordDoc = oWordApp.Documents.Open(FlName)
'~~> Delete the bookmarks
For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
oWordDoc.Bookmarks(BookMarksToDelete(i)).Delete
Next i
End If
MsgBox "Done"
End Sub
Does your code work? It's a little unclear what you're asking, unless that's just for feedback. All I personally have to say is the way you declare variables.
So if you know what the variable will hold, it's best to declare it as such. For example,
Dim myRange as Range
Dim myArray(2) as String
myArray = {"cat", "dog", "bird"}
Dim reqName as String
I'm no expert either, just trying to help! Feel free to ask any questions, but I can't guarantee I have an answer.
I am having trouble creating a macro that will find a specified value in my active sheet within a range in my "Information" sheet. If the cell value us not found in the range then it will give me a message box stating "Value not Found" I have the following but it is not working:
Sub testrot()
Dim i As String
Dim srchrng As Range
Sheets(ActiveSheet.Name).Select
i = Cells(2, 5)
Sheets("Information").Select
Set srchrng = Range("j8:j17").Find(what = i)
If Not srchrng Is Nothing Then
MsgBox "Not Found"
End If
End Sub
The cell (2,5) in my active sheet is for example #16, and in the range (j8:j17) it is a list of different strings #16, #17, etc.
I appreciate any advice.
Thanks.
You want to avoid .Select/.Activate
Sub testRot2()
Dim str As String
Dim srchRng As Range
With Worksheets(ActiveSheet.Name)
str = .Cells(2, 5).Value
Set srchRng = .Range("J8:J17").Find(what:=str)
If srchRng Is Nothing Then
MsgBox "Not found"
End If
End With
End Sub
Also, note that I changed i to str. This is a personal choice, as I typically see i as a Long/Integer for looping. You can keep it i though, just thought to mention it. Also, note the colon required in Find(what:=str).
I am working in excel. I need to be able to find the first blank/empty cell in row 20 starting from column A. The return should be the actual column namei.e. AB, AAD, etc. What I am going to do is paste a value into this cell. Here is a picture of it with that row highlighted in green.
Dim wkb As Excel.Workbook
Dim wks2 As Excel.Worksheet
Dim strMSG As String
Dim LastRow As Long
Set wkb2 = ThisWorkbook
Set wks2 = wkb2.Sheets("Daily")
columnNumber = wks2.Cells(20, wks2.Columns.Count).End(xlToLeft).Column
Your query of: -
to find the first blank/empty cell in row
Is not answered by your code wks2.Cells(20, wks2.Columns.Count).End(xlToLeft).Column. Its a subtle but significant difference.
.End(xlToLeft) or .End(xlUp) is often used to find the last used cell in a row/column, a common requirement. To find the first used cell you either want to check each one or create a range based on all blank cells in a range, and look at the first item in that range.
The below code did it for me, and included the column reference as a letter.
Public Sub Sample()
Dim wkb2 As Excel.Workbook
Dim wks2 As Excel.Worksheet
Dim strMSG As String
Dim StrColumn As String
Set wkb2 = ThisWorkbook
Set wks2 = wkb2.Worksheets("Daily")
StrColumn = Replace(wks2.Range("20:20").SpecialCells(xlCellTypeBlanks).Cells(1, 1).Address, "$", "")
StrColumn = Left(StrColumn, Len(StrColumn) - 2)
Set wks2 = Nothing
Set wkb2 = Nothing
End Sub
I have a function that converts a column number to its letter, but I will try and convert it to simple code.
dim colLetter as string
Dim vArr
vArr = Split(Cells(1, columnNumber).address(True, False), "$")
colLetter = vArr(0)
I am not sure how well it works standalone. The function that I use is:
Public Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).address(True, False), "$")
Col_Letter = vArr(0)
End Function
And I know that works. Use whichever you like!