Here's my code:
Need my code to enter TRUE in a cell if it finds a value in column A of sheet "Itemschedule" to be present in column B of sheet "Whereused". Getting "Type mismatch" error. If I change the "st = Sheets(..." line to .Value instead of .Text, or if I change the .Find line to LookIn:=xlFormulas instead of Lookin:=xlValues, it gives the same error irrespective of the combination of the two.
Private Sub CommandButton1_Click()
Dim rowLast As Integer
Dim str As String
Dim cell As Range
Sheets("Itemschedule").ListObjects("Table2").Range.AutoFilter
rowLast = Sheets("Itemschedule").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Itemschedule").ListObjects("Table2").Resize Range("A1:E" & rowLast)
Sheets("Itemschedule").Range("A" & rowLast + 1 & ":E" & Rows.Count).ClearContents
For i = 2 To rowLast
str = Sheets("Itemschedule").Cells(i, "A").Text
With Sheets("Whereused").Range("B:B")
Set cell = .Find(What:=str, After:=.Range("B1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
End With
If cell Is Nothing Then
Sheets("Itemschedule").Cells(i, "E").Value = "FALSE"
Else
Sheets("Itemschedule").Cells(i, "E").Value = "TRUE"
End If
Next
On Error Resume Next
Sheets("Itemschedule").ListObjects("Table2").Range.AutoFilter
Sheets("Itemschedule").Range("A1:E" & rowLast).AutoFilter Field:=1, Criteria1:="FALSE"
Sheets("Itemschedule").Range("A1:E" & rowLast).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sheets("Itemschedule").ListObjects("Table2").Resize Range("A1:E" & rowLast)
Sheets("Itemschedule").ListObjects("Table2").Range.AutoFilter
End Sub
I have tried a lot but am not able to figure it out. I'm sure it's something silly.
Please help.
Your error is due to the fact that the After parameter is not inside the range you are searching. This part:
With Sheets("Whereused").Range("B:B")
Set cell = .Find(What:=str, After:=.Range("B1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
End With
should be:
With Sheets("Whereused").Range("B:B")
Set cell = .Find(What:=str, After:=Sheets("Whereused").Range("B1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
End With
otherwise the .Range("B1") is relative to Range("B:B") and therefore refers to C1.
Dictionaries are more efficient at finding duplicate values.
Sub CommandButton1_Click()
Dim keyword As String, keyvalue As Variant
Dim rowLast As Long, x As Long
Dim dicItems
Set dicItems = CreateObject("scripting.dictionary")
With Sheets("Whereused")
rowLast = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To rowLast
keyword = .Cells(x, 2)
keyvalue = .Cells(x, 2)
'Add Key Value pairs to Dictionary
If Not dicItems.Exists(keyword) Then dicItems.Add keyword, keyvalue
Next
End With
With Sheets("Itemschedule")
rowLast = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To rowLast
keyword = .Cells(x, 1)
.Cells(x, 2) = dicItems.Exists(keyword)
Next
End With
End Sub
But the proper way to do it place a WorkSheet Formula in Itemschedule Column B.
=COUNTIF(Table1[[#This Row],[Items]],Table2[[#Headers],[Items]])>0
Related
My goal is to search for a specific value in column "K" and to return a specific result. But an obstacle I'm facing is that it is not going in order from top to bottom when searching the column but rather just executing "find" for "add" even though there is "term" before it. Is there a way to make it read in order cell by cell for the column?
Sub Find_Stuff()
Dim s As String
Dim rCell As Range
Dim lReply As Long
Dim firstaddress As String
Dim rngOriginal As Range
Dim Cell As Range
Dim n As Long
Set Cell = Columns("K:K").Find(What:="Add", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Cell Is Nothing Then
firstaddress = Cell.Address
Cell.Offset(0, -9).Resize(, 4).Insert shift:=xlDown
Cell.Offset(0, 1).Value = "add "
n = Range("K" & Rows.Count).End(xlUp).Row
Range("K9").AutoFill Destination:=Range("K9:K" & n), Type:=xlFillDefault
Cell.Select
Else
Set Cell = Columns("K:K").Find(What:="Term", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Cell Is Nothing Then
firstaddress = Cell.Address
Cell.Offset(0, -4).Resize(, 4).Insert shift:=xlDown
Cell.Offset(0, 1).Value = "term "
n = Range("K" & Rows.Count).End(xlUp).Row
Range("K9").AutoFill Destination:=Range("K9:K" & n), Type:=xlFillDefault
Cell.Select
Else
Set Cell = Columns("K:K").Find(What:="Remove", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Cell Is Nothing Then
firstaddress = Cell.Address
Cell.Offset(0, -4).Resize(, 4).Insert shift:=xlDown
Cell.Offset(0, 1).Value = "Remove"
n = Range("K" & Rows.Count).End(xlUp).Row
Range("K9").AutoFill Destination:=Range("K9:K" & n), Type:=xlFillDefault
Cell.Select
Else
Columns("K:K").Select
Set Cell = Selection.Find(What:="New", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Cell Is Nothing Then
Cell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = _
"New"
Cell.Select
End If
On Error GoTo 0
End If
On Error GoTo 0
End If
On Error GoTo 0
End If
On Error GoTo 0
End Sub
But an obstacle I'm facing is that it is not going in order from top to bottom when searching the column but rather just executing "find" for "add" even though there is "term" before it. Is there a way to make it read in order cell by cell for the column?
This is the standard behaviour of .Find(). This is the description of the After parameter in MSDN:
The cell after which you want the search to begin. This corresponds to the position of the active cell when a search is done from the user interface. Notice that After must be a single cell in the range. Remember that the search begins after this cell; the specified cell isn't searched until the method wraps back around to this cell. If you do no specify this argument, the search starts after the cell in the upper-left corner of the range.
To make sure that the .Find() starts searching from the first cell, you have to pass as a parameter the last cell:
Sub TestMe()
Dim myR As Range
Dim myS As Range: Set myS = Range("B1:B5")
With myS
Set myR = .Find(1)
Debug.Print myR.Row
Set myR = .Find(1, after:=.Cells(.Cells.Count))
Debug.Print myR.Row
End With
End Sub
I would like help finding out the appropriate code to get AutoFill for my formula in column K to work from one cell under the one that is found, all the way to the last row of the document. How can this be achieved?
Thank you!
Dim s As String
Dim rCell As Range
Dim lReply As Long
Dim firstaddress As String
Dim rngOriginal As Range
Dim Cell As Range
Columns("K:K").Select
Set Cell = Selection.Find(What:="Add", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Cell Is Nothing Then
firstaddress = Cell.Address
Cell.Offset(0, -6).Insert shift:=xlDown
Cell.Offset(0, -7).Insert shift:=xlDown
Cell.Offset(0, -8).Insert shift:=xlDown
Cell.Offset(0, -9).Insert shift:=xlDown
Cell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = _
"Add. "
Range("K9").AutoFill Destination:=Range("K9:K1936"), Type:=xlFillDefault
Cell.Select
ActiveCell.FormulaR1C1 = _
""
No need to use Autofill :) You can input formula in one go!
Like this (UNTESTED)?
Dim ws As Worksheet
Set ws = Sheet1 '<~~ Change as applicable
'
' ~~> Rest of your code
'
With ws '<~~ This is your worksheet object
LRow = .Range("K" & .Rows.Count).End(xlUp).Row
.Range("K9:K" & LRow).Formula = .Range("K9").Formula
End With
'
' ~~> Rest of your code
'
Think you could have found this out yourself as it's a common VBA question. I've also removed the Selects from your code which are generally unnecessary and inefficient.
Sub x()
Dim s As String
Dim rCell As Range
Dim lReply As Long
Dim firstaddress As String
Dim rngOriginal As Range
Dim Cell As Range
Dim n As Long
Set Cell = Columns("K:K").Find(What:="Add", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Cell Is Nothing Then
firstaddress = Cell.Address
Cell.Offset(0, -9).Resize(, 4).Insert shift:=xlDown
Cell.Offset(0, 1).Value = "Add. "
n = Range("K" & Rows.Count).End(xlUp).Row
Range("K9").AutoFill Destination:=Range("K9:K" & n), Type:=xlFillDefault
Cell.Value = 1
End If
End Sub
I am facing some issues with VBA. Let me explain what I am trying to achieve. I have 2 sheets in 1 workbook. They are labelled "Sheet1" and "Sheet2."
In "Sheet1," there are 100 rows and 100 columns. In column A, it is filled with eg: SUBJ001 all the way to SUBJ100. In "Sheet2," there is only 1 Column A, with a range of rows. Eg: "SUBJ003, SUBJ033, SUBJ45." What I am trying to achieve is to use my mouse, highlight the column A in "Sheet2," and compare each individual cell with the cells in column A. Should there be a match, it will copy the entire row and paste them in a new sheet that the macro creates in the same workbook. However, i am experiencing an out of range error at Set Rng =.Find(What:=Arr(I), ... Thanks!
Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Rng = Application.InputBox("Select target range with the mouse", Type:=8)
MyArr = Rng
Set NewSh = Worksheets.Add
With Sheets("Sheet1").Range("A:A")
Rcount = 0
For I = LBound(MyArr) To UBound(MyArr)
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
Rng.EntireRow.Copy NewSh.Range("A" & Rcount)
' Use this if you only want to copy the value
' NewSh.Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
MyArr = Rng is setting MyArr to be a two-dimensional array where the first rank corresponds to the rows in Rng and the second rank corresponds to the columns in Rng.
Assuming you only have one column in Rng, then your Find statement should refer to the values in that first column using MyArr(I, 1), i.e.
Set Rng = .Find(What:=MyArr(I, 1), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
I am trying to select from A9 to the lastrow & lastcolumn.
I have this to select the last cell, but it doesn't select from A9 to Last it just selects the lastrow/lastcolumn. Also this is not ideal because if I have blanks in the future.
I have searched and could not find anything for selecting from a cell to the lastrow & lastcolumn
Sub FindLast()
Application.ScreenUpdating = False
Range("A9").End(xlToRight).End(xlDown).Select
Application.ScreenUpdating = True
End Sub
Search order in my file would be Column A & Row 8 if that helps at all.
Code Below is what I am using to work on active sheets
Sub SelectAll()
Application.ScreenUpdating = False
Dim lastRow As Long, lastCol As Long
Dim Rng As Range
Dim WholeRng As Range
With ActiveWorksheet
Set Rng = Cells
'last row
lastRow = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'last column
lastCol = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
Set WholeRng = Range(Cells(9, "A"), Cells(lastRow, lastCol))
WholeRng.Select
End With
Application.ScreenUpdating = True
End Sub
Or you could exploit UsedRange
Sub FindLast()
With Activesheet
.Range(.Range("A9"), .UsedRange.Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Select
End With
End Sub
The safest way is use the Find function:
Option Explicit
Sub LastRow_Col_Find()
' Safest way to ensure you got the last row:
Dim lastRow As Long, lastCol As Long
Dim Rng As Range
Dim WholeRng As Range
With Worksheets("report")
Set Rng = .Cells
' Safest way to ensure you got the last row
lastRow = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'MsgBox lastRow ' <-- for DEBUG
' Safest way to ensure you got the last column
lastCol = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
'MsgBox lastColumn ' <-- for DEBUG
' set the Range for the entire UsedRange in "YourSheetName" sheet
Set WholeRng = .Range(.Cells(9, "A"), .Cells(lastRow, lastCol))
WholeRng.Select '<-- ONLY IF YOU MUST
End With
End Sub
I am trying to create a macro in excel VBA, that searches the Range (B1:B30) of the value of the ActiveCell in Column “B” by a loop. Along with the search of Column, I also want to check if the date’s cell is colored with a particular color. If the date's cell equals the set color "Good", then I want it to change the color of the cell in Column H of the same row as selected to red.
When I run the code, I get an error message of “Run-time error ‘424’: Object required.” When I go to debug the problem, it highlights the .Find function I have and points to the last line of the search which is “SearchFormat:=False).Activate” What should I do to fix this problem?
Any improvement with my overall code will be very much appreciated.
Sub Find()
Dim FirstAddress As String
Dim MySearch As Variant
Dim Rng As Range
Dim I As Long
MySearch = Array(ActiveCell)
With Sheets("Sheet1").Range("B1:B30")
For I = LBound(MySearch) To UBound(MySearch)
Set Rng = .Find(What:=MySearch(I), _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False).Activate
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If ActiveCell.Style.Name = "Good" Then
Rng("H" & ActiveCell.Row).Select
Rng.Interior.ColorIndex = xlColorIndexRed
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
End Sub
Showing the Debug mode of the run-time error.
Screenshot of the Spreadsheet for reference
Code Review:
You have several problems here.
MySearch = Array(ActiveCell) will always be a single value. So why bother looping through it
You cannot set a range to equal range.activate. Searching Sheets("Sheet1").Range("B1:B30") implies that you are searching a worksheet other that the ActiveSheet. If this is the case than .Find(After:=Activecell) suggests that you are looking for a value after the ActiveCell of another worksheet.
Set Rng = .Find(What:=MySearch(I), _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False).Activate
Rng("H" & ActiveCell.Row) Rng is a Range object. It doesn't work like Range. You cannot pass it a cell address. You can do this Rng(1,"H") which is really shorthand for Rng.cells(1,"H") bit that is misleading because Rng is in column 2 Rng(1,"H") will reference the value in column I.
Sub Find()
Dim FirstAddress As String
Dim MySearch As Variant
Dim Rng As Range
Dim I As Long
MySearch = ActiveCell 'This is the ActiveCell of the ActiveSheet not necessarily Sheets("Sheet1")
With Sheets("Sheet1").Range("B1:B30")
Set Rng = .Find(What:=MySearch, _
After:=.Range("B1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If Rng.Style.Name = "Good" Then
.Range("H" & Rng.Row).Interior.ColorIndex = xlColorIndexRed
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
End With
End Sub
UPDATE:
Here is the actual answer to your question:
Sub FindMatchingValue()
Const AllUsedCellsColumnB = False
Dim rFound As Range, SearchRange As Range
If AllUsedCellsColumnB Then
Set SearchRange = Range("B1", Range("B" & Rows.count).End(xlUp))
Else
Set SearchRange = Range("B1:B30")
End If
If Intersect(SearchRange, ActiveCell) Is Nothing Then
SearchRange.Select
MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled"
Exit Sub
End If
Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
SearchFormat:=False)
If Not rFound Is Nothing Then
Do
If rFound.Style.Name = "Good" Then
Range("H" & rFound.Row).Interior.Color = vbRed
End If
Set rFound = SearchRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
End If
End Sub
You can't put Activate at the end of the findthe way you are trying to do.
Try this as you find statement.
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Rng.Activate
Then if you want to Activate the range, do that. But, it is best to stay away from Select, Activate etc in VBA code. I strongly suggest not using that last line of code and adjust you code to not rely on Select and Activate.
you may want to consider an Autofilter approach so as to loop only through relevant cells, as follows:
Option Explicit
Sub Find()
Dim cell As Range
With Sheets("Sheet1").Range("B1:B30")
.Rows(1).Insert '<--| insert a dummy header cell to exploit Autofilter. it'll be removed by the end
With .Offset(-1).Resize(.Rows.Count + 1) '<--| consider the range expanded up to the dummy header cell
.Rows(1) = "header" '<--| give the dummy header cell a dummy name
.AutoFilter field:=1, Criteria1:=ActiveCell '<--| filter range on the wanted criteria
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell other than "header" one has been filtered...
For Each cell In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) '<--| ... loop through filtered cells only
If cell.Style.Name = "Good" Then cell.Offset(, 6).Interior.ColorIndex = 3 '<--| ... and color only properly styled cells
Next cell
End If
.AutoFilter '<--| .. show all rows back...
End With
.Offset(-1).Resize(1).Delete '<--|delete dummy header cell
End With
End Sub