I have a 2 columns range as the first image shows, and a userform with a 2 column listbox, a textbox and a commandbutton.
Is there a code so that if I enter a value in the textbox, then the code search my range until it found this value and return the corresponding value from the other column AND ALL THE FOLLOWING VALUES TILL IT COMES TO THE FIRST NON BLANK CELL IN THE FIRST COLUMN.
For example, If I enter "DDD" in the textbox, the first column in the listbox will show "DDD" and the second one will show 444, 555and 666 respectively.
This is the code I'm using, but when I enter "AAA" in the textbox, .end(xldown) goes to "DDD" and not "BBB". Is there a way to solve this ??
Thank u in advance.
Dim SearchTerm As String
Dim topCell As Range, BottomCell As Range
SearchTerm = TextBox1.Text
With Sheet1.Range("A:A")
Set topCell = .Find(SearchTerm, after:=.Cells(Rows.Count, 1), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext, MatchCase:=False)
If topCell Is Nothing Then
MsgBox SearchTerm & " not found."
Else
Set BottomCell = Range(topCell.End(xlDown).Offset(-1, 0), .Cells(Rows.Count, 2).End(xlUp)).Cells(1, 2)
With ListBox1
.Clear
.List = Range(topCell, BottomCell).Value
End With
End If
End With
Use the code below as a reference to establish which cell is actually the bottom cell for the range of values. Let me know if you need help using it.
Sub DoTheThang()
Dim TopCell As Range
Dim BottomCell As Range
Dim SearchString As String
Dim rngUsed As Range
SearchString = "EEE"
Set TopCell = Range("A:A").Find(SearchString, Cells(1, 1))
Set BottomCell = TopCell
Set rngUsed = Sheet1.UsedRange
Do While BottomCell.Offset(1).Value = "" And Not Intersect(BottomCell, rngUsed) Is Nothing
Set BottomCell = BottomCell.Offset(1)
Loop
MsgBox TopCell.Address
MsgBox BottomCell.Address
End Sub
Related
My question is in the title. I have searched up everywhere and this one feels like the only answer that is working:
https://stackoverflow.com/a/15180079/17038705
I have created a sample Excel file and validated that his VBA code works, the sample he shows looks like it is working too. However, when I ran it with the Excel file I am working on, I got Error 91, Object variable or With block variable not set.
After some digging, it is probably because of his Find() function that returns Nothing.
My question is why this is the case for my file and not for others. The values there are based on formulas and values of other cells, would that be a problem?
Other approaches are appreciated as well. Thanks!
Since your data contains formulas, you need to set the LookIn parameter to xlValues in the Find method. I updated the original code with these changes, take a look:
Sub Highlight_Duplicate_Entry()
Dim ws As Worksheet
Dim cell As Range
Dim myrng As Range
Dim clr As Long
Dim lastCell As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
Set myrng = ws.Range("A2:D" & Range("A" & ws.Rows.Count).End(xlUp).Row)
With myrng
Set lastCell = .Cells(.Cells.Count)
End With
myrng.Interior.ColorIndex = xlNone
clr = 3
For Each cell In myrng
If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
' addresses will match for first instance of value in range
'[================]
If myrng.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then
' set the color for this value (will be used throughout the range)
cell.Interior.ColorIndex = clr
clr = clr + 1
Else
' if not the first instance, set color to match the first instance
'[================]
cell.Interior.ColorIndex = myrng.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
End If
End If
Next
End Sub
A slightly different approach using a Dictionary to track values vs. colors:
Sub Tester()
ColorDups Range("A1").CurrentRegion
End Sub
Sub ColorDups(rng As Range)
Dim c As Range, dict As Object, i As Long, v
Set dict = CreateObject("scripting.dictionary")
i = 0
Application.ScreenUpdating = False
For Each c In rng.Cells
v = CStr(c.Value)
If Len(v) > 0 Then
If Not dict.exists(v) Then
dict.Add v, c 'store the first cell with this value
Else
If TypeOf dict(v) Is Range Then 'second cell with this value?
i = i + 1 'next index
dict(v).Interior.ColorIndex = i 'color the first cell
dict(v) = i 'store the index
End If
c.Interior.ColorIndex = dict(v) 'color this duplicate
End If
End If
Next c
End Sub
I'm trying to write a macro to put the name of the steward in a cell if they are assigned to that category. I wrote this code so far but it isn't working. I'm trying to get it so that if a cell of a column in one worksheet matches the cell of another worksheet and if it does, then it will print the name of the steward in a separate cell to identify that that category is owned by that person.
The numbers are in the worksheet Demetri in the range of E27 to E38 and I want to see if the cells in the range BE4 to BE163803 from the worksheet Share_Dump are in the range from the Demetri worksheet.
Sub steward_products()
Dim d, s As Worksheet
Set d = Worksheets("Demetri")
Set s = Worksheets("Share_Dump")
For i = 4 To 163803 Step 1
For j = 27 To 38 Step 1
If s.Cells(i, 3) = d.Cells(j, 5) Then
s.Cells(i, 57) = "Demetri"
End If
Next j
Next i
Please try this code. I think it will do what you need.
Option Explicit
Sub Steward_Products()
' 236
' use descriptive names and use the declarations to explain them
' use Option Explicit and capitalization to avoid typos
Dim WsSteward As Worksheet ' Demetri
Dim WsDump As Worksheet ' Share_Dump
Dim Fnd As Range
Set WsSteward = Worksheets("Demetri")
Set WsDump = Worksheets("Share_Dump")
With WsDump
' presuming that columns 28:38 are not longer than column 27
Set Fnd = .Range(.Cells(4, 27), .Cells(.Rows.Count, 27).End(xlUp)) _
.Resize(, 12)
Set Fnd = Fnd.Find(WsSteward.Cells(5, "J").Value, _
LookIn:=xlValues, LookAt:=xlWhole)
If Fnd Is Nothing Then
MsgBox "Product """ & WsSteward.Cells(5, 10).Value & """ wasn't found.", _
vbInformation, "Invalid product description"
Else
.Cells(Fnd.Row, 57) = "Demetri"
End If
End With
End Sub
I have a macro that loops through cells of one sheet, looks for that value in another sheet, and then highlights the row if they match. I'd like to add a message box that would pop up if a matching value is not found. I know this is a simple problem, but I'm having trouble figuring out in which loop to put my booleans.
Sub MarkXfer_noX()
Dim rng As Range
Dim rng2 As Range
Set rng = Worksheets("Transferred Routings").UsedRange
Dim i As Integer
Dim j As Integer
Dim ProdCI As String
Dim found As Boolean
Dim intRowCount As Integer
intRowCount = Sheets("Transferred Routings").UsedRange.Rows.count
For i = 2 To intRowCount
If rng.Cells(i, 1) <> "" Then ProdCI = rng.Cells(i, 1) 'get the ProdCI number from column A if not blank
Worksheets("All_ProCI").Activate 'activate main page
Set rng2 = Worksheets("All_ProCI").UsedRange 'select a range on the main page
For j = 2 To rng2.Rows.count 'from row 2 to the end
If rng2.Cells(j, 2) = ProdCI Then 'if the ProdCI in column B matches the one we picked,
Call FillCell(j) 'call a sub in a different module and give it our current row
found = True
Else
found = False
End If
Next
Next
If found = False Then
MsgBox (ProdCI & " not found") 'Display a message if one of the items wasn't found on the main page. Currently has an error where the last one in the list always pops up.
Else
End If
End Sub
Right now it always shows a msgbox with the last value in the range no matter what.
Thanks all, here is the updated working code using the Find function
Sub MarkXfer_Find()
'Re-tooled to use the .Find function instead of looping through each
Dim rng As Range
Dim rng2 As Range
Set rng = Worksheets("Transferred Routings").UsedRange
Dim i As Integer
Dim ProdCI As String
Dim intRowCount As Integer
Dim intRowCount2 As Integer
Dim aCell As Range
intRowCount = Sheets("Transferred Routings").UsedRange.Rows.count
For i = 2 To intRowCount
If rng.Cells(i, 1) <> "" Then ProdCI = rng.Cells(i, 1) 'get the ProdCI number from column A if not blank
Worksheets("All_ProCI").Activate 'activate main page
Set rng2 = Worksheets("All_ProCI").UsedRange 'select a range on the main page
intRowCount2 = Worksheets("All_ProCI").UsedRange.Rows.count
'use the Find function to put a value in aCell
Set aCell = rng2.Range("B1:B" & intRowCount2).Find(What:=ProdCI, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'MsgBox ProdCI & " found"
Call FillCell(aCell.row)
Else 'If aCell is blank display msgbox
MsgBox "ProdCI """ & ProdCI & """ not found"
End If
Next
End Sub
I have sheet 1 with range of names. I have a msg box input where I can just click the cell referencing the value. If it matches, it finds where that value lies in column C of sheet 2. It works how I want it to, but I need to figure out how to highlight the whole row. Also, is there a scroll to indexing I can do to make sure it moves down sheet 2 to where that row was highlighted?
Code:
Sub tgr()
Dim rFound As Range
Dim lemployee As String
Dim sh As Worksheet
Dim rw As Long
Dim matched As Boolean
lemployee = Application.InputBox("Please selct an employee", "Employee Name", Type:=2)
If lemployee = "False" Then Exit Sub
Set sh = Sheets("Sheet1")
rw = 2
With ThisWorkbook.Worksheets("Sheet2").Columns("C")
Set rFound = .Find(lemployee, .Cells(.Cells.Count), xlValues, xlWhole)
If ThisWorkbook.Worksheets("Sheet2").Cells(rFound.Row, 3).Value = lemployee Then
.Cells(rFound.Row).Interior.Color = VBA.RGB(255, 255, 0)
End If
End With
End Sub
EDIT: As for the scroll, I would just need something like:
Application. Goto ActiveCell.EntireRow,True
Something like this:
With ThisWorkbook.Worksheets("Sheet2").Columns("C")
Set rFound = .Find(lemployee, .Cells(.Cells.Count), xlValues, xlWhole)
If Not rFound Is Nothing Then
rFound.EntireRow.Interior.Color = VBA.RGB(255, 255, 0)
Application.Goto rFound
End If
End With
I got little project in VBA and stuck on below topic.
I need to select range from searched value to first empty cell in H column.
Selected range should looks like this
Selected Range in Excel:
I searched for specific value in column A and if I found it it's being set as first cell in range. ( It works)
Then I need to find last cell in range which is first empty cell in last column.
This is what I've found and try to use
Sub Button()
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Worksheets("SS19").Activate
ActiveSheet.Range("A:A").Select
Set cell = Selection.Find(What:=StringToFind, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
cell.Select
With Worksheets("SS19")
Set rr = .Range(ActiveCell, .Cells(.Rows.Count, "H").End(xlUp))
With rr
rr.Parent.Range(.Cells(1, "A"), .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0)).Select
End With
End With
If cell Is Nothing Then
Worksheets("SS19").Activate
MsgBox "String not found"
End If
I tried to searched for first empty cell in prevously selected range so it won't search the whole column but it doesn't work.
Try this...
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
With ws
Dim findCel As Range
Set findCel = .Range("A:A").Find(StringToFind, , , xlWhole, , , False, , False)
Dim lRow As Long
lRow = .Range(findCel.Address).Offset(, 7).End(xlDown).Row + 1
Dim rr As Range
Set rr = .Range("A" & findCel.Row & ":" & "H" & lRow)
rr.Select
End With
I find that using the worksheet's match function is easier than Range.Find when searching a single column.
Option Explicit
Sub Button()
Dim stringToFind As String, m As Variant
Worksheets("SS19").Activate
stringToFind = Application.InputBox("Enter string to find", "Find string", Type:=xlTextValues)
With Worksheets("SS19")
m = Application.Match(stringToFind, .Range("A:A"), 0)
If Not IsError(m) Then
If Not IsEmpty(.Cells(m + 1, "H")) Then
.Range(.Cells(m, "A"), .Cells(m, "H").End(xlDown).Offset(1)).Select
Else
.Range(.Cells(m, "A"), .Cells(m, "H").Offset(1)).Select
End If
End If
End With
End Sub
Using .End(xlDown) could be problematic if the first cell under row m in column H was blank and this should be checked for or you might find the selection reaching too far, possibly all the way down to the bottom of the worksheet. Checking for a non-blank cell will catch this potential problem.