I am facing a problem in my code.
While searching, it only search the lower case values. However i want it search whether the value is capital or small or mix.
Here is my code.
Private Sub CommandButton1_Click()
Dim intValueToFind As String
Dim ws As Worksheet, tbl As ListObject, rng As Range
Set ws = Sheets("Sheet1")
Set tbl = ws.ListObjects(Me.ComboBox1.Value)
Set rng = tbl.ListColumns(1).DataBodyRange
intValueToFind = Me.TextBox3.Value
For Each rng In rng ' Revise the 500 to include all of your values
If LCase(rng.Value) = intValueToFind Then
MsgBox ("Found value on row " & rng.Value)
Exit Sub
End If
Next rng
' This MsgBox will only show if the loop completes with no success
MsgBox ("Value not found in the range!")
End Sub
Kindly review and advise how can i get the solution what i need...
Thanks
Salman
Related
I'm trying to create a macro that would allow me to extract data from an array to send an email.
The sorting must be done according to the comments. The goal is to detect the date of the day, for example today 22/08/2022, and to extract the line in another page by erasing in the comment box, the comments which are not dated today , ie have the whole line with the last comment in the comment box. On the other hand, if there is no comment dating from today, the line must not be selected or copied.
However, no matter what code I enter, I cannot sort the data according to the date and only retrieve today's comment, knowing that in this excel I only have a few lines but I have to be able to use it for 1000 rows.
How should I go about it?
Thank you and have good day
My example table
The result that I try to have
Solution
Option Explicit
Sub TodaysComments()
Dim srcWs As Worksheet
Dim destWs As Worksheet
Dim myCell As Range
Dim rngToCopy As Range
' Set source and find comments column
Set srcWs = Worksheets("Source")
Set myCell = srcWs.Cells.Find("Commentaires")
If myCell Is Nothing Then
MsgBox "Cannot find column 'Commentaires'!", vbCritical
Exit Sub
End If
' Set and clear destination
Set destWs = Worksheets("Filtered")
destWs.Cells.Clear
' Copy Header
RngCopy CurrentRow(myCell), destWs.Range("A1")
' Loop over comments
NextCell myCell
Do While myCell.Value <> ""
' Search for today's date
If Not myCell.Find(Today) Is Nothing Then
' Aggregate rows to copy
Set rngToCopy = RngUnion(rngToCopy, CurrentRow(myCell))
End If
NextCell myCell
Loop
' No comments today
If rngToCopy Is Nothing Then
MsgBox "No 'Commentaires' rows meet criteria!", vbInformation
Exit Sub
End If
' Copy rows to destination
RngCopy rngToCopy, destWs.Range("A2")
' Clear old comments from destination
Set myCell = destWs.Cells(2, myCell.Column)
Do While myCell.Value <> ""
ClearOldComments myCell
NextCell myCell
Loop
MsgBox "Done!", vbInformation
End Sub
Private Sub RngCopy(SrcRng As Range, DestRng As Range)
SrcRng.Copy
DestRng.PasteSpecial xlPasteAll
DestRng.Range("A1").PasteSpecial xlPasteColumnWidths
Application.CutCopyMode = False
End Sub
Private Function CurrentRow(myCell As Range) As Range
Set CurrentRow = Range(myCell, myCell.Worksheet.Cells(myCell.Row, 1))
End Function
Private Sub NextCell(myCell As Range)
Set myCell = myCell.Offset(1, 0)
End Sub
Function RngUnion(Rng1 As Range, Rng2 As Range) As Range
If Rng2 Is Nothing Then Err.Raise 91 ' Object variable not set
If Rng1 Is Nothing Then
Set RngUnion = Rng2
Exit Function
End If
Set RngUnion = Union(Rng1, Rng2)
End Function
Private Sub ClearOldComments(myCell As Range)
Dim Comments As Variant
Dim i As Long
Comments = VBA.Split(myCell.Value, vbNewLine)
For i = LBound(Comments) To UBound(Comments)
' NOTE: We assume there is only one comment per day.
If InStr(Comments(i), Today) Then
myCell.Value = Comments(i)
Exit Sub
End If
Next
' Should not be possible
Err.Raise 93 ' Invalid pattern string
End Sub
Function Today() As String
Today = FormatDateTime(Date, vbGeneralDate)
End Function
Looking for help to achieve searching a range of cells E9:E with All cells containing "Accommodation & Transportation" and changing the value of the cells adjacent to them with 0. , I was not able to get anything online with similar topic and I'm not too good with VBA coding, though i am able to understand what the code will provide in results.
I Have a Commandbutton1 with the below code :
Sub CommandButton1_click()
Dim blanks As Excel.Range
Set blanks = Range("F9:F" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
blanks.Value = blanks.Offset(0, -1).Value
End Sub
Further i have a command button that will select only cells that are not blank. I need the above result because if the below code selects Non Blank cells from Columns E:F it wont be selecting cells adjacent to those containing "Accommodation & Transportation" as they are blank cells and it will return the error "Runtime Error '1004' This action wont work on multiple selections".
The below code acts the same as [Go to Special => Constants]
Sub SelectNonBlankCells()
Dim rng As Range
Dim OutRng As Range
Dim InputRng As Range
Dim xTitle As String
On Error Resume Next
xTitle = Application.ActiveWindow.RangeSelection.Address
Set InputRng = Range("E8:F500")
ActiveWindow.ScrollRow = 1
For Each rng In InputRng
If Not rng.Value = "" Then
If OutRng Is Nothing Then
Set OutRng = rng
Else
Set OutRng = Application.Union(OutRng, rng)
End If
End If
Next
If Not (OutRng Is Nothing) Then
OutRng.Select
End If
End Sub
Maybe you can try another approach, if your goal is to edit cells adjacent to certain cells. The code below is based on an example in the Help file of the Range.Find function:
Sub DoSomething()
Dim sh As Worksheet
Set sh = ActiveSheet
Dim checkRange As Range
Set checkRange = sh.Range("E8:F500") ' your intended range to search
Dim foundRange As Range
Set foundRange = checkRange.Find("Accommodation & Transportation")
Dim firstAddr As String
If Not foundRange Is Nothing Then
firstAddr = foundRange.Address
Do
' use foundRange to access adjacent cells with foundRange.Offset(row, col)
'
'
foundRange.Offset(0, 1) = "all good"
Set foundRange = checkRange.FindNext(foundRange)
Loop While Not foundRange Is Nothing And foundRange.Address <> firstAddr
End If
End Sub
Or even better, you could add some parameters to make it more reusable:
Sub Main()
DoSomething "Accommodation & Transportation", ActiveSheet.Range("E8:F500")
End Sub
Sub DoSomething(ByVal findWhat As String, ByVal searchWhere As Range)
Dim foundRange As Range
Set foundRange = searchWhere.Find(findWhat)
Dim firstAddr As String
If Not foundRange Is Nothing Then
firstAddr = foundRange.Address
Do
' use foundRange to access adjacent cells with foundRange.Offset(row, col)
'
'
foundRange.Offset(0, 1) = "all good"
Set foundRange = searchWhere.FindNext(foundRange)
Loop While Not foundRange Is Nothing And foundRange.Address <> firstAddr
End If
End Sub
There is a cell in another worksheet whose value ranges from 1 to 100, I have defined its name as "SpanLength" in the name manager. In the worksheet I am now concerned with, I want to find the cell which contains the same value as "SpanLength", that is, a value from 1 to 100, within the range I have defined as "FindSpanLength". Then I want to call the column that this cell is within "outputcolumn" so that I can use this column further in the script. How can I do this?
The line of code before End Sub causes the error message 'Wrong number of arguments or invalid property assignment'
I am a VBA novice and no doubt my code is fraught with errors, so would appreciate any help I can get. I have already scoured google for answers but haven't found any specific enough for me to understand.
Sub OutputMaximums()
Dim spanlengthcell As Range
Set spanlengthcell = Range("FindSpanLength").Find("SpanLength")
Range("spanlengthcell").Column(1) = outputcolumn
End Sub
New Code, with error message 1004 (Method 'Range' of object '_Worksheet' failed):
Sub OutputMaximums()
Dim spanlengthcell As Range, outputcolumn As Long
Set spanlengthcell = OUTPUT.Range("FindSpanLength").Find(Range("SpanLength").Value)
If Not spanlengthcell Is Nothing Then
outputcolumn = spanlengthcell.Column
End If
End Sub
When you assign a value to a variable, the variable is on the left hand side of the equals sign.
When using Find always check first that your search term is found before trying to access its properties to avoid subsequent errors.
It is also advisable to specify a number of Find parameters as they may have unexpected settings from when last used on a worksheet.
Sub OutputMaximums()
Dim spanlengthcell As Range, outputcolumn As Long
Set spanlengthcell = Range("FindSpanLength").Find(Range("SpanLength").Value)
If Not spanlengthcell Is Nothing Then
outputcolumn = spanlengthcell.Column
End If
End Sub
Option Explicit
Sub test()
Dim rngSearch As Range, rngFound As Range
Dim strSearch As String
Dim ColumnNo As Long
strSearch = "Bingo"
With ThisWorkbook.Worksheets("Sheet1")
Set rngSearch = .UsedRange
Set rngFound = rngSearch.Find(strSearch)
If rngFound Is Nothing Then
MsgBox strSearch & " does not excist in range."
Else
ColumnNo = rngFound.Column
MsgBox "Text appears in column " & ColumnNo & "."
End If
End With
End Sub
Sub ShowNamedRange()
'The named Range "SpanLenght" must be on the Sheet "SheetWithNamedRange"!
Debug.Print Sheet("SheetWithNamedRange").Range("SpanLength").Address
Debug.Print Sheet("SheetWithNamedRange").Range("SpanLength").Column
End Sub
and after reading the question again:
Sub SearchRange()
Dim rngSearch As Range
Dim rngFound As Range
Dim strSearch As String
strSearch = Sheets("SheetWithNamedRange").Range("SpanLength").Value
Set rngSearch = Sheets("SheetWithFINDRange").Range("FindSpanLength")
Set rngFound = rngSearch.Find(strSearch)
If Not (rngFound Is Nothing) Then _
MsgBox "Found in column " & rngFound.Column & _
" on the sheet """ & rngFound.Parent.Name & """!"
End Sub
I am iterating through a column and wanting to catch the cells that meet the string of text that I am searching for. My problem occurs when I try and set the address of the cell that has met the criteria of the search into a Range object. Line:
Set testRng = i.Range.Adress
Gives me error " Wrong number of arguments or invalid property assignment" and I'm not sure what the issue is here?
This is the entire code I am working with:
Sub Tester()
Dim rng As Range
Dim testRng As Range
Dim i As Variant
Dim cmpr As String
Dim usrInputA As String
usrInputA = InputBox("Col 1 Criteria: ")
Set rng = Range("A2:A10")
For Each i In rng
cmpr = i.Value
If InStr(cmpr, usrInputA) Then
If testRng Is Nothing Then
Set testRng = i.Range.Address
Else
Set testRng = testRng & "," & i.Range.Address
End If
Else
MsgBox "No hit"
End If
Next
End Sub
You should declare i as a Range (not Variant)
Use Union to group together a collection of cells instead of trying to manually build the string yourself
Switch the order of your range set. You only need Set rngTest = i once so I would put this at the bottom so you don't have to keep spamming it.
Option Explicit
Sub Tester()
Dim testRng As Range, i As Range
Dim usrInputA As String
Dim LR as Long
usrInputA = InputBox("Col 1 Criteria: ")
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each i In Range("A2:A" & LR)
If InStr(i, usrInputA) Then
If Not testRng Is Nothing Then
Set testRng = Union(testRng, i)
Else
Set testRng = i
End If
End If
Next i
If Not testRng is Nothing Then
'Do what with testRng?
End If
End Sub
I am trying to do the following. I have several spreadsheets that are named something like "ITT_198763" where the ITT part stays the same but the number changes. I also have one tab called program where the 6 digit number is imported on row 40 (hence the RngToSearch below). I need the program to 1) find the "ITT" sheet for a certain 6 digit number, 2) identify the corresponding row in the "Program" tab, and copy information from the "ITT" tab to row 41 of the identified column. I will be copying more information from the ITT sheet to the specified column, but for now I am just trying to get it to work once.
From the MsgBox, I know it identifies the correct prjNumber (the 6 digit number), but I get the runtime 1004 error on the line Set RngDest. Any help will be appreciated!
Sub Summary_Table()
Dim wks As Worksheet
Dim RngToSearch As Range, RngDest As Range
Dim foundColumn As Variant
Dim prjNumber
For Each wks In ActiveWorkbook.Worksheets
If ((Left(wks.Name, 3) = "ITT")) Then
prjNumber = Right(wks.Name, 6)
MsgBox (prjNumber)
Set RngToSearch = Sheets("Program").Range("C40:q40")
foundColumn = Sheets("Program").Application.Match(prjNumber, RngToSearch, False)
With Sheets("Program")
Set RngDest = .Range(1, foundColumn) 'Project Name
End With
If Not IsError(foundColumn) Then
wks.Range("E2").Copy RngDest
End If
End If
Next wks
End Sub
I tried the .cell instead with the following code (all else is the same) and now get runtime error 13 on the Set RngDest line:
Set RngToSearch = Sheets("Program").Range("C40:q48")
foundColumn = Sheets("Program").Application.Match(prjNumber, RngToSearch.Rows(1), False)
With Sheets("Program")
Set RngDest = RngToSearch.Cells(1, foundColumn) 'Project Name
End With
Yuo are getting that error because foundColumn has an invalid value. Step through the code and see what is the value of foundColumn
Here is an example which works.
Sub Sample()
Dim RngDest As Range, RngToSearch As Range
foundColumn = 1
Set RngToSearch = Sheets("Program").Range("C40:q40")
Set RngDest = RngToSearch.Cells(1, foundColumn)
Debug.Print RngDest.Address
End Sub
Add MsgBox foundColumn before the line Set RngDest = RngToSearch.Cells(1, foundColumn) and see what value do you get. I guess the line
foundColumn = Sheets("Program").Application.Match(prjNumber, RngToSearch, False)
is not giving you the desired value. Here is the way to reproduce the error.
EDIT (Solution)
You need to handle the situation when no match is found. Try something like this
Sub Sample()
Dim RngDest As Range, RngToSearch As Range
Set RngToSearch = Sheets("Program").Range("C40:q40")
foundcolumn = Sheets("Program").Application.Match(1, RngToSearch, False)
If CVErr(foundcolumn) = CVErr(2042) Then
MsgBox "Match Not Found"
Else
Set RngDest = RngToSearch.Cells(1, foundcolumn)
'
'~~> Rest of the code
'
End If
End Sub
You are looking for the Cells function, which has the prototype .Cells([RowIndex], [ColumnIndex]). The Range function takes either a string with a range name (like "A1", or a named range), or other range references.
I figured it out! Found column was the problem. Combining that with the help from the other commenters, the following works:
Sub Summary_Table()
Dim wks As Worksheet
Dim RngToSearch As Range, RngDest As Range
Dim foundColumn As Variant
Dim prjNumber
For Each wks In ActiveWorkbook.Worksheets
If ((Left(wks.Name, 3) = "ITT")) Then
prjNumber = Right(wks.Name, 6)
MsgBox (prjNumber)
Set RngToSearch = Sheets("Program").Range("a40:q48")
foundColumn = Sheets("Program").Rows(40).Find(what:=prjNumber, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Column
MsgBox (foundColumn)
With Sheets("Program")
Set RngDest = RngToSearch.Cells(2, foundColumn) 'Project Name
Debug.Print RngDest.Address
End With
If Not IsError(foundColumn) Then
wks.Range("E3").Copy RngDest
End If
End If
Next wks
End Sub