How to loop Range.Find in VBA? - vba

I am new to VBA so please don't judge too harsh. Having said that below is my issue with Range.Find.
I have a crosstab with a column that has "https" link to pictures; and I have a working VBA to turn these links into actual pictures in each cell for that column. However, my issue is when I add another column into the Crosstab or move column around, my VBA stops working and I end up with my links without actual pictures (since, the picture code is set to the initial column where my links reside).
I figured there should be a way to make it more dynamic by using Range.Find. I have managed to find information on Range.Find, but my code won't work. Is there anyway anyone could help out?
Here is the code:
Function picRng() As Range
Set picRng = ActiveSheet.Range("A1:Z1000")
Set rngFindValue = ActiveSheet.Range("A1:Z1000").Find(what:="http", Lookat:=xlPart)
Do
Set rngFindValue = Search.FindNext(rngFindValue)
Loop While Not rngFindValue is Nothing
End Function

if you want to loop thru all the instances of the search arguments here is the correction of your code
Function picRng() As Range
Set picRng = ActiveSheet.Range("A1:Z1000")
Set rngfindvalue = picRng.Find(what:="http", Lookat:=xlPart)
If Not rngfindvalue Is Nothing Then
rngFirstAddress = rngfindvalue.Address
Do
MsgBox rngfindvalue.Address
Set rngfindvalue = picRng.FindNext(rngfindvalue)
Loop Until rngfindvalue Is Nothing Or rngfindvalue.Address = rngFirstAddress
End If
End Function

You do not need a loop for Find(). If you need the last value in Find(), you need to refer it in the arguments (searchDirection) Something like this will give the last value:
Public Function LocateFind() As Range
Dim rngCell As Range
Dim rngRangeToLookAt As Range
Set rngRangeToLookAt = Range("A1:A100")
Set LocateFind = rngRangeToLookAt.Find("YourValueHere", searchdirection:=xlPrevious)
End Function

Set lx_rangeFind = ActiveSheet.UsedRange.Find(What:=strToFind, LookIn:=xlValues, LookAt:=xlPart)
Set lx_rangeFindFirst = lx_rangeFind
Do
Set lx_rangeFind = ActiveSheet.UsedRange.Find(What:=strToFind, LookIn:=xlValues, LookAt:=xlPart, After:=lx_rangeFind)
'Rest of the code
'now lx_rangeFind has the cell Number
Loop While lx_rangeFindFirst.Address <> lx_rangeFind.Address

Related

VBA code to only show rows that contain similar text to an input field?

I'm new to VBA and am trying to cobble together some code to allow a user to input a word (or several words) into a cell and then show a list of matching row entries.
I have tried the following code but am getting an "instring = type mismatch" error.
Note that "B3" is the field dedicated for the "search word" and column F is the column containing the text I want to search within. If the word is contained, I want to show that row and hide all rows that don't contain that word.
Sub Find_Possible_Task()
ROW_NUMBER = 0
SEARCH_STRING = Sheets("codeset").Range("B3")
ROW_NUMBER = ROW_NUMBER + 1
ITEM_IN_REVIEW = Sheets("codeset").Range("F:F")
If InStr(ITEM_IN_REVIEW, SEARCH_STRING) Then
Do
Cells(c.Row).EntireRow.Hidden = False
Loop Until ITEM_IN_REVIEW = ""
End If
End Sub
TIA!
Few bad coding conventions or even possibly downright errors:
It's a good practice to explicity declare the scope Public/Private of your Sub procedure
Unless you're passing the variables from some place else, they need to be declared with Dim keyword
Using Option Explicit will help you prevent aforementioned error(s)
(Subjective) variables in all caps are ugly and in most programming languages it is convention to reserve all caps variables names for constants (Const)
Option Explicit
Private Sub keep_matches()
Dim what As Range
Dim where As Range
Dim res As Range ' result
Dim lr As Long ' last active row
Dim ws As Worksheet: Set ws = Sheets("codeset")
lr = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
Set what = ws.Range("B3")
Set where = ws.Range("F1:F" & lr)
' we'll create an extra column for a loop in our .Find method
where.Copy
ws.Range("F1").EntireColumn.Insert
ws.Range("F1").PasteSpecial xlPasteValues
where.EntireRow.Hidden = True ' preemptively hide them all
Set where = ws.Range("F1:F" & lr)
Set res = where.Find(what, lookIn:=xlValues) ' ilook for matches, 1st attempt
If Not res Is Nothing Then ' if found
Do Until res Is Nothing ' repeat for all results
res.EntireRow.Hidden = False
res = "Checked"
Set res = where.FindNext(res)
Loop
Else
MsgBox("No matches were found")
where.EntireRow.Hidden = False ' we don't wanna hide anything
End If
ws.Range("F1").EntireColumn.Delete ' remove the extra help column for Find method
End Sub
Should work as expected.
If there are any question, let me know.
instead of instr(), consider range.find().
Sub Find_Possible_Task()
Dim SEARCH_STRING As String
Dim ITEM_IN_REVIEW As Range
Dim found As Range
Dim i As Integer
SEARCH_STRING = Sheets("Sheet1").Range("B3").Value
i = 1
Do
Set ITEM_IN_REVIEW = Sheets("Sheet1").Cells(i, 6)
Set found = ITEM_IN_REVIEW.Find(What:=SEARCH_STRING)
If found Is Nothing Then
ITEM_IN_REVIEW.EntireRow.Hidden = True
End If
i = i + 1
Loop Until ITEM_IN_REVIEW = ""
End Sub
alternatively, consider using filter table:
1. check if your table has filter on ==> if yes, pass. if no, turn on filter.
2. filter column F for keyword to contain value in cell B3.

Finding a value in the range

I am writing a subroutine that looks through a range of cells starting in cell A1 (the range is 1 column wide) containing String values. My sub first finds the entire range and assign it to a Range variable "theForest" to help make searching easier. Then, it looks through each cell in the range until it finds the word “Edward”. If he is found or not, it display the result in a message (stating that he was or was not found).
The code I have so far is this:
With Range("A1")
'this will help find the entire range, since it is only one column I will search by going down
theForest = Range(.Offset(0,0), .End(xlDown)).Select
Dim cell As Range
For Each cell In theForest
If InStr(Edward) Then
Msgbox"He was found"
Else
Msgbox"He was not found sorry"
End If
Next cell
End With
However I am getting numerous errors upon running the program and I think the issue is with the
theForest = Range(.Offset(0,0), .End(xlDown.)).Select
line of code. I would appreciate any guidance into this simple code.
Thank you :)
EDIT: Here is some new code I have come up with:
Dim isFound As Boolean
isFound = False
With Range("A1")
For i = 1 to 500
If .Offset(1,0).Value = "Edward" Then
isFound = True
Exit For
End If
Next
End With
If isFound = True Then
Msgbox " Edward was found"
Else
MsgBox "Edward was not found"
End if
Then again it does not include finding the entire range and assiging it to the range variable theForest.
Dim theForest as Range, f as Range
Set theForest = ActiveSheet.Range(ActiveSheet.Range("A1"), _
ActiveSheet.Range("A1").End(xlDown))
Set f = theForest.Find("Edward", lookat:=xlWhole)
If Not f Is Nothing Then
Msgbox"He was found"
Else
Msgbox"He was not found sorry"
End If

Excel VBA find address and assign to variable then reuse value

I'm trying to find if there's a given title on a cell, pass the address of that cell to a variable and use such location to adjust the size of the column. The reason I'm doing this is because I'm writing several functions which will shift the position of the columns. I'd appreciate it if someone could take a look and tell me what I'm doing wrong.
Option Explicit
Sub adjustColumns()
Dim PONumberCell As String
Dim PONumberAddress As Range
Dim TopLabelinColumn As Range
For Each TopLabelinColumn In Range("A1:Z1").Cells
If TopLabelinColumn Like "PO_NUMBER" Then TopLabelinColumn.Value = "PO"
PONumberCell = TopLabelinColumn.Address
Set PONumberAddress = PONumberCell
PONumberAddress.ColumnWidth = 70
Next TopLabelinColumn
End Sub
edited after OP's further request:
you are confusing a Range object (such as PONumberCell is meant to be) with a String variable one (like PONumberAddress), so
Set PONumberAddress = PONumberCell
doesn't work because you are trying to assign an object variable to a String one
but you can be more effective avoiding the loop and using the Find() method
Option Explicit
Sub adjustColumns()
Dim PONumberAddress As String
Dim PONumberCell As Range
Set PONumberCell = Range("A1:Z1").Find(what:="PO_NUMBER", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not PONumberCell Is Nothing Then
With PONumberCell
.value = "PO"
PONumberAddress = .Address
.EntireColumn.ColumnWidth = 70
End With
Else
Set PONumberCell = Range("A1:Z1").Find(what:="PO", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| if it didn't find "PO_NUMBER" then it seaches for a complete match of "PO"
If Not PONumberCell Is Nothing Then PONumberCell.EntireColumn.ColumnWidth = 70
End If
End Sub
Following the comments above, there are a few erros in your code:
Setting the PONumberAddress Range, you need to use the syntax : Set PONumberAddress = Range(PONumberCell) using the address string found in brackets.
To set the column width, use : PONumberAddress.Columns.ColumnWidth = 70.
According to your post, I think you want to do this only for columns where the header text is "PO_NUMBER", therefore you need all the code below inisde your If : If TopLabelinColumn.Value Like "PO_NUMBER" Then.
Code
Option Explicit
Sub adjustColumns()
Dim PONumberCell As String
Dim PONumberAddress As Range
Dim TopLabelinColumn As Range
For Each TopLabelinColumn In Range("A1:Z1").Cells
If TopLabelinColumn.Value Like "PO_NUMBER" Then
TopLabelinColumn.Value = "PO"
PONumberCell = TopLabelinColumn.Address
Set PONumberAddress = Range(PONumberCell)
PONumberAddress.Columns.ColumnWidth = 70
End If
Next TopLabelinColumn
End Sub

someExcel VBA: Cannot create a range object successfully

This is my first question here, so bear with me. I'm a security consultant working on a huge firewall migration, for which I got my VBA skill from under a thick layer of dust. So far I have managed to get all my issues resolved by searching, but this issue: I get errors when doing exactly how I find it everywhere.
What I want to do:
I have an array that contains (among other things), strings formatted like this: "A3:P59", representing a cell range.
Now, this are ranges within a table. When I get the address of a certain cell in the table, I want to test if it's in that range.
I wrote a test function:
Function TestCellRange() As Boolean
Dim tbl As ListObject
Dim cell, rng, test As range
Dim range As range
Dim bRow, eRow As Integer
Set tbl = shRulebase.ListObjects("tblBFFirewallRules")
shRulebase.Activate
With shRulebase
cell = tbl.DataBodyRange(5, 1).Address(False, False) 'it's this command that gives me issues
Set range = .range(.Cells(bRow, 1), .Cells(eRow, 16))
Debug.Print cell
'Set rng = shRulebase.range(range)
Debug.Print rng
Set test = Application.Intersect(cell, range(range(A3), range(P59)))
If test Is Nothing Then
MsgBox ("oops")
TestCellRange = False
Else
MsgBox ("yup yup")
TestCellRange = True
End If
End With
End Function
Now whatever I try, I keep getting blocked on the set range:
set range = .Range("A3:P59") -> will return "object required", on the "set test" line (if i use intersect (cell, range))
Set range = range("A3:P59") -> will return object variable or with block variale not set on the same line
Set range = .range(.Cells(bRow, 1), .Cells(eRow, 16)) -> will step through, but debug.print returns a type mismatch and "Set test = Application.Intersect(cell, range)" returns a "object required"
Any help would be really appreciated...I'm all to familiar with networks ip's and the bits and bytes of it, but here I am a bit out of my comfort zone and I need to finish this by tomorrow :(
Greetings,
Kraganov
EDIT Some More tries:
rng and cell as variant:
cell = tbl.DataBodyRange(5, 1).Address(False, False)
rng = .range("A3:P59").Address(False, False)
Set test = Application.Intersect(cell, rng)
==>I would get objects required
just using rng as range and trying to set it without "set"
rng = .range("A3:P59")
EDIT 2 : I found a way around using the range.
So what I was trying to do, was the following:
I had a table that contains information about firewall rules. However, not every line describes a rule. There are also lines that described the context in which the rules below that line were to be placed.
Outside of the table, aside of those lines there would be a cell with the range of cells for that context. I wanted to use that to describe the context for those rules, if I pulled them.
I ended up looping through the table rows and identifying those specific rows and setting a "context" variable when, a row like that was met.
Try setting the cell as well as following:
set cell = tbl.DataBodyRange(5, 1).Address(False, False)
What is cell? A Range?
You do not need to add 'set' to the range value assignment.
Try just
range = .Range("A3:P59")
Function TestCellRange() As Boolean
Dim tbl As ListObject
Dim cellToTest As Range
Dim testResult As Range
Set tbl = shRulebase.ListObjects("tblBFFirewallRules")
Set cellToTest = tbl.DataBodyRange.Cells(5, 1)
'or with one more level of indirection
'Set cellToTest = shRulebase.range(tbl.DataBodyRange.Cells(5, 1).Value)
Set testResult = Application.Intersect(cellToTest, [A3:P59])
If testResult Is Nothing Then
MsgBox ("oops")
TestCellRange = False
Else
MsgBox ("yup yup")
TestCellRange = True
End If
End Function
Thanks to the post of VincentG I found the working solution. Thanks for that.
Function TestCellRange() As Boolean
Dim tbl As ListObject
Dim cellToTest As range
Dim testResult As range
Set tbl = shRulebase.ListObjects("tblBFFirewallRules")
shRulebase.Activate
Set cellToTest = tbl.DataBodyRange.Cells(5, 1)
'or with one more level of indirection
'Set cellToTest = shRulebase.range(tbl.DataBodyRange.Cells(5, 1).Value)
Set testResult = Application.Intersect(cellToTest, range("A3:P59"))
If testResult Is Nothing Then
MsgBox ("oops")
TestCellRange = False
Else
MsgBox ("yup yup")
TestCellRange = True
End If
End Function

Excel not recognizing year when changing to date format with VBA

I'm having trouble changing to date format. I have cells containing different dates but not all of them are formatted as date. One of them is "yy-mm-dd", for example "13-04-08", but it is formatted as General.
I'm using this code:
xCell = Format(xCell, "yyyy-mm-dd")
Problem is that excel cannot tell if "13" or "08" is the "yyyy" so it doesn't change anything. How do I solve this? Do I need to tell excel which numbers are year before it changes the date, and how do I do that? Can it be included in the Format method?
EDIT:
I think I need to explain the whole thing as the problem seems to lay somewhere else.
The cells containing the dates look like this from start, being formatted as General:
13-05-06 A
13-05-21 A
...
I remove the unwanted 'A' with this code:
Sub rensa()
Dim Found As Range
For Each xCell In Range("D2:D999")
If IsEmpty(xCell.Value) Then Exit For
Set Found = xCell.Find(What:="A", LookIn:=xlValues, LookAt:=xlPart)
If Found Is Nothing Then
Else
xCell.Value = Left(xCell.Value, Len(xCell.Value) - 1)
End If
Next xCell
End Sub
I have tried these codes to set the cell format to date:
Range("D2:D999").NumberFormat = "yyyy-mm-dd"
Range("D2:D999").NumberFormat = "m/d/yyyy"
I have also tried to implement them in the For loop like this:
Sub rensa()
Dim Found As Range
For Each xCell In Range("D2:D999")
If IsEmpty(xCell.Value) Then Exit For
Set Found = xCell.Find(What:="A", LookIn:=xlValues, LookAt:=xlPart)
If Found Is Nothing Then
xCell.NumberFormat = "yyyy-mm-dd"
Else
xCell.Value = Left(xCell.Value, Len(xCell.Value) - 1)
xCell.NumberFormat = "yyyy-mm-dd"
End If
Next xCell
End Sub
But that didn't work as I wanted either. Everything makes the result look like this, still formatted as General:
13-05-06
13-05-21
...
So the A is gone, but nothing else changes.
i just added something in your code. See below lines with comments
Sub rensa()
Dim Found As Range
Dim xcell As Range
Dim date_val As Date
For Each xcell In Range("D1:D999")
If IsEmpty(xcell.Value) Then Exit For
Set Found = xcell.Find(What:="A", LookIn:=xlValues, LookAt:=xlPart)
If Found Is Nothing Then
Else
xcell.Value = Left(xcell.Value, Len(xcell.Value) - 1)
date_val = xcell.Value 'asign the value to date variable carrier
xcell.Value = date_val 'return it to the cell
End If
Next xcell
Range("D1:D999").NumberFormat = "yyyy-mm-dd" 'do the formatting
End Sub
Hope this works.
Quite simple solution is to parse your data using Mid, Left, Right functions. However, it's not such efficient one would expect but possibly would be helpful. So, the code could be as follows:
xCell = "13-04-08"
xCell = Format(DateSerial(Left(xCell,2),mid(xCell,4,2),Right(xCell,2)),"yyyy-mm-dd")
as a result you get 2013-04-08.
Edit To set appropriate cell formatting try one of the following:
Range("A1").NumberFormat = "yyyy-mm-dd"
or
Range("A1").NumberFormat = "m/d/yyyy"
Where Range("A1") is reference to your cell/range in Excel sheet.