I am new to Vba(and coding in general) and have written a very basic macro to find out "wood" inside a particular column from a larger set of data, however when I try to run it, it's still searching from the whole data set instead of the specified column.
I started with keeping the range of Cel to the whole data set, and then just narrowed it to the third column. However, when I remove the find element the immediate window shows me the address of cells in the third column, just as I want, but as soon as I use Find, it searches through the whole dataset.
I've tried defining propertied in Find object such as After and SearchOrder, but then it shows an error.
Dim emptyrow As Long
emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
Dim Cel As Range
Dim n As Integer
Set Cel = Range("C2:C54")
For n = 2 To emptyrow
Debug.Print (Cel.Cells(n,3).Find("wood","C2",,,xlByColumn).Address)
Next n
On using properties of Find, I get a type mismatch error.
It's not clear what exactly you want to do with the results, but here are a couple of possible outputs.
Sub xx()
Dim rFind As Range, s As String, v() As Variant, i As Long
With Range("C2:C54")
Set rFind = .Find(What:="Wood", After:=.Cells(.Cells.Count), _
Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
s = rFind.Address
Do
Debug.Print rFind.Offset(, -2).Value 'column A value in immediate window
i = i + 1
ReDim Preserve v(1 To i)
v(i) = rFind.Offset(, -2).Value 'or store values in an array
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> s
End If
End With
MsgBox Join(v, ", ")
End Sub
Use this:
Sub fnd_all_wood()
Dim c As Range
Dim firstaddress As String
With Range("C2:C54")
Set c = .Find("wood", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Debug.Print c.Address
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstaddress
End If
DoneFinding:
MsgBox "Done All"
End With
End Sub
This will print all the Cell Address in Range C2:C54 where it finds Wood
More information about the Formula Range.FindNext in the Link.
Update:
You can change the line Debug.Print c.Address to any other code where you can get the row by c.row and use it to get the other values like cells(c.row,1) to get the value from Ist column.
Demo:
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 have a task to make a VBA macro based on few sections in .xls file.
I know that in this file it will always be three sections which starts with specific name in example file "Block". But starting row where "Block" is written each time could be different.
Example of .xls file:
enter image description here
My approach had been to search for address of each column containing string "Block"
And later make further code based on knowing there start of each block are.
My code so far:
Public Values
Sub Macro1()
FindAll ("Block")
Debug.Print Values
'
End Sub
Sub FindAll(text)
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
fnd = text
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
'Find next cell with fnd value
Set FoundCell = myRange.FindNext(after:=FoundCell)
'Add found cell to rng range variable
Set rng = Union(rng, FoundCell)
'Test to see if cycled through to first found cell
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Creates global value with all found adresses
Values = rng.Address
Exit Sub
Output Is received as intended:
$A$5,$A$8,$A$1
However I struggle to select element for further coding.
I tried:
Debug.Print Values.Rows.item(1).Adress
Debug.Print Values.Rows.item(1,1).Adress
Debug.Print Values.Rows.item(1)
Debug.Print Values.Rows.item(1,1)
But it yields "Run-time error '424' "
My desired output would be to create three variables containing addresses for these sections.
That
Debug.Print Section_1
Debug.Print Section_2
Debug.Print Section_3
Would yield:
$A$1
$A$5
$A$8
Is there a way to select nth element from union in VBA?
If you want to access the single cells of the range, you can simply loop over it:
Dim cell as Range
For Each cell In rng
Debug.Print cell.Address
Next
Could also be done using an index:
Dim i As Long
For i = 1 To rng.Count
Debug.Print rng(i).Address
Next
Now in your example, you combine single cells using Union. If you combine larger ranges and want to access those ranges, you can use the Areas-Property. However, Excel will optimize the areas, if you do Union(Range("A1"), Range("A2)), you will end up with one area A1:A2.
With ActiveSheet
Set rng = Union(.Range("D5:E16"), .Range("A1:F12"), .Range("X4"))
End With
Dim a As Range
For Each a In rng.Areas
Debug.Print a.Address
Next
For i = 1 to rng.Areas.Count
Debug.Print rng(i).Address
Next
Btw: Every Range (even a single cell) has the Areas-property set, so it's always safe to loop over the Areas of a range.
Try,
Public Values
Public rngDB() As Range
Sub Macro1()
Dim i As Integer
FindAll ("Block")
Debug.Print Values
For i = LBound(rngDB) To UBound(rngDB)
Debug.Print rngDB(i).Address
Debug.Print rngDB(i).Cells(1).Address
Debug.Print rngDB(i).Cells(1, 2).Address
Debug.Print rngDB(i).Cells(2, 1).Address
Next i
End Sub
Sub FindAll(text)
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim sAddress() As String
Dim n As Integer
fnd = text
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
'GoTo NothingFound
End If
Set rng = FoundCell
'Loop until cycled through all unique finds
Do
n = n + 1
ReDim Preserve rngDB(1 To n)
ReDim Preserve sAddress(1 To n)
Set rngDB(n) = FoundCell.CurrentRegion
sAddress(n) = rngDB(n).Address
Set FoundCell = myRange.FindNext(after:=FoundCell)
Loop While FoundCell.Address <> FirstFound
'Creates global value with all found adresses
If n Then
Values = Join(sAddress, ",")
End If
End Sub
Would like to have a column range searched for specific text ("REASON") and when found, have that entire cell content be filled onto a range of different cells.
This is done until a new "REASON" is found - in which case this cell content will be copied accordingly like before.
This is before result:
before
... and expected result, with filled text in J column
Thanks guys, been messing with this but not sure where to go from here:
Sub AddSus()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
cel.Offset(1, 0).Value = cel.Value
End If
Next cel
End Sub
There's a few things wrong with this. As you iterate through cel in SrchRng your conditional is checking the value of that cel to contain "REASON". This is not what you want. What you are essentially doing is checking for the "REASON" string and saying all entries below this, until the next reason, should be true for a conditional to populate column J.
Lets, really briefly, run through the logic of a single cell to illustrate why your code was not doing what you wanted:
In cell G3, you check to see if it contains the "REASON" string. It does not, so there is no assignment of any value anywhere. The following will do what you want:
Sub AddSus()
Dim SrchRng As Range, cel As Range, reasonString As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
reasonString = cel.Value
ElseIf cel.Value <> "" Then
cel.Offset(0, 3).Value = reasonString
End If
Next cel
End Sub
Minor note but if you are in column G and you want to populate column J, the offset should be .offSet(0,3).
Use FIND to quickly jump between instances of REASON:
Sub AddSus()
Dim SrchRng As Range
Dim rFound As Range
Dim lStart As Long, lEnd As Long
Dim sFirstAddress As String
Dim sReason As String
Set SrchRng = ThisWorkbook.Worksheets("Sheet1").Range("G:G")
'Find the first instance of REASON in column G.
Set rFound = SrchRng.Find(What:="REASON:", _
After:=SrchRng.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'Check something has been found before continuing.
If Not rFound Is Nothing Then
'Find just keeps looping unless you tell it to stop,
'so record the first found address.
sFirstAddress = rFound.Address
Do
'Save the reason and start row.
sReason = rFound.Value
lStart = rFound.Row
'Find the next REASON in column G.
Set rFound = SrchRng.FindNext(rFound)
If rFound.Address = sFirstAddress Then
'The first instance has been found again, so use column I to find last row of data.
lEnd = SrchRng.Offset(, 2).Cells(Rows.Count, 1).End(xlUp).Row
Else
lEnd = rFound.Row
End If
'Fill in from 2 rows down from Start and 2 rows up from End.
'This will go wrong if there's not enough space between REASONs.
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Cells(lStart + 2, 10), .Cells(lEnd - 2, 10)) = sReason
End With
Loop While rFound.Address <> sFirstAddress
End If
End Sub
A Quick and Dirty Solution...
Sub AddSus()
Dim SrchRng As Range, cel As Range
Dim reason As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
reason = cel.Value
End If
If cel.Column = 10 And Len(cel.Offset(,-1)) > 0 Then
cel.Value = reason
End If
Next
End Sub
I'm super new to VBA and hoping I could get some help please ... I'm looking for a succinct way to remove rows from a sheet via Macro and the VBA samples I've tried I cant get to work. I'm hoping it's something simple :)
The macro would remove a row that DOES NOT contain a specific values (from a specific column) from within an array. I sort of had it working, and full disclosure, I've borrowed code from other examples. The latest sample I'm working with just deletes everything, the other sample I was working with deleted Acro32.exe, but kept everything else. So not yet arrived at a solution.
Background: I have a CSV output from an application auditing tool, which spits out tonnes of app data from various computers. That CSV data will be copied into my master 'reporting' spreadsheet. I am only interested in reviewing and keeping data about specific applications, namely Chrome.exe, Firefox.exe, Acro32.exe and Winword.exe. The application name is always found in Column F. So, any cell contents found in Column F, that DOES NOT contain a value in an array, that entire row needs to be deleted. Ideally :) and the remaining rows will only include apps I'm interested in as defined in the array.
Any thoughts would be appreciated.
Thanks
Public Function GetLastRow(ByVal rngToCheck As Range) As Long
Dim rngLast As Range
Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastRow = rngToCheck.Row
Else
GetLastRow = rngLast.Row
End If
End Function
Sub Apps_Formatting()
Dim varList As Variant
Dim lngLastRow As Long, lngCounter As Long
Dim rngToCheck As Range, rngFound As Range
Dim rngToDelete As Range, rngDifferences As Range
Dim blnFound As Boolean
Application.ScreenUpdating = False
With ActiveSheet
lngLastRow = GetLastRow(.Cells)
'we don't want to delete our header row
Set rngToCheck = .Range("A2:A" & lngLastRow)
End With
If lngLastRow > 1 Then
With rngToCheck
'any Cell in Column F that contains one of these values are KEPT
'and if not found in cell, then the entire row is deleted.
varList = VBA.Array("Chrome.exe", "Firefox.exe", "Acro32.exe")
For lngCounter = LBound(varList) To UBound(varList)
Set rngFound = .Find( _
what:=varList(lngCounter), _
Lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=True)
'check if we found a value we want to keep
If Not rngFound Is Nothing Then
blnFound = True
'if there are no cells with a different value then
'we will get an error
On Error Resume Next
Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)
On Error GoTo 0
If Not rngDifferences Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngDifferences
Else
Set rngToDelete = Application.Intersect(rngToDelete, rngDifferences)
End If
End If
End If
Next lngCounter
End With
If rngToDelete Is Nothing Then
If Not blnFound Then rngToCheck.EntireRow.Delete
Else
rngToDelete.EntireRow.Delete
End If
End If
Application.ScreenUpdating = True
End Sub
To follow up on this thread, should someone else benefit, the code below was provided and worked really well.
Sub a1077712b()
'https://www.mrexcel.com/forum/excel-questions/1077712-vba-remove-rows-xlsx-where-particular-text-can-found-within-cell.html
Dim i As Long, r As Range
Dim va As Variant, arr As Variant, flag As Boolean
arr = Array("Chrome.exe", "Firefox.exe", "Acro32.exe", "Winword.exe")
Set r = Range("F2", Cells(Rows.count, "F").End(xlUp))
va = r
For i = 1 To UBound(va, 1)
flag = False
For Each x In arr
If InStr(1, va(i, 1), x, 1) > 0 Then flag = True: Exit For
Next
If flag = False Then va(i, 1) = ""
Next
r = va
r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
In column 'G' of my worksheet I have cells with the text 'Months Billed' - I have code which searches for this text and in the cell next to the text increments the value by 1.
I found the code on this site but for some reason I get a run-time error 13 - Type Mismatch after it has changed all of the values. EDIT - I did a step into, once the code has run through column G and changed all of the values, it loops back to the For Each statement and then I get the run-time error at the found.offset statement.
Here is my code:
Sub UpdateMonthsBilled()
Dim findRng As Range, _
targetRng As Range, _
findCell As Range, _
found As Range
Dim firstFound As String, _
columnName As String
Dim Month As Integer
Month = 1
columnName = "G"
Set findRng = Range("G5:H650")
For Each findCell In findRng
Set targetRng = Range(columnName & "2", Range(columnName & Rows.Count).End(xlUp))
With targetRng
Set found = .Find(findCell.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not found Is Nothing Then
firstFound = found.Address
Do
found.Offset(0, 1).Value = found.Offset(0, 1).Value + 1
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstFound
End If
End With
Next findCell
End Sub
Any help would be appreciated as I have no idea where I am going wrong?
I copied your code to VBA, and ran it.
It seems that rows G1 through G4 are being incremented as well.
No errors, however. This is Excel 2003.