I wrote this quick For Loop as part of my macro to find cells in utwbk, based on a list of values in dewbk. The loop seems to go fine for a few cells and then crashes. The problem is, it crashes for different values each time but the values DO exist in utwbk. Here is my code:
Dim utpath As String
Dim utwbk As Workbook
Dim ogfund As String
Dim ogcell As Range
Dim newfund As String
Dim newcell As Range
Dim t As Long
For t = 2 To tempfundlastrow
If dewbk.Sheets("Macro").Cells(t, 1).Value <> "" Then
Set ogcell = dewbk.Sheets("Macro").Cells(t, 1)
ogfund = Trim(ogcell.Value)
With utwbk.Sheets("Report").Range(Cells(1, 1), Range("AAA1").SpecialCells(xlCellTypeLastCell))
Set newcell = .Find(ogfund, LookIn:=xlValues, lookat:=xlWhole)
End With
newfund = newcell.Value
newcell.Offset(2, 0).Value = ogcell.Offset(0, 8).Value
newcell.Offset(3, 0).Value = ogcell.Offset(0, 9).Value
newcell.Offset(4, 0).Value = ogcell.Offset(0, 11).Value
newcell.Offset(6, 0).Value = ogcell.Offset(0, 10).Value
Else
'nothing
End If
Next t
The code crashes with run-time error 91: 'Object variable of with block variable not set' on this line:
newfund = newcell.Value
In the previous line where I define newcell, ogfund has a value and I can find that value in utwbk so really not sure what's going on. I am assuming my syntax for the .Find is incorrect but I do not know how to rectify this. As usual, any help is greatly appreciated!
After the line
Set newcell = .Find(ogfund, LookIn:=xlValues, lookat:=xlWhole)
Type this
If newcell Is Nothing Then
MsgBox "Not found"
Exit Sub
End If
If you see the message box that means .Find couldn't find the search text and since it couldn't find, the newcell.Value will break the code as newcell is Nothing
BTW if you look for a word BLAH and in your cell you have BLAH with leading and trailing spaces then your .Find will not find the word because you are using lookat:=xlWhole. Maybe you want lookat:=xlPart
It's a common mistake. In
utwbk.Sheets("Report").Range(Cells(1, 1), Range("AAA1").SpecialCells(xlCellTypeLastCell))
Cells(1, 1) and Range("AAA1") refer to ranges in the currently active sheet
What you probably want is more like
With utwbk.Sheets("Report")
With .Range(.Cells(1, 1), .Range("AAA1").SpecialCells(xlCellTypeLastCell))
Set newcell = .Find(ogfund, LookIn:=xlValues, lookat:=xlWhole)
End With
End With
or just
With utwbk.Sheets("Report").UsedRange
Set newcell = .Find(ogfund, LookIn:=xlValues, lookat:=xlWhole)
End With
Related
So I am creating a module to find a text string in a sheet to print into another sheet, the code works But it feels cumbersome, i have to run the code multiple times to get the results I want, i know a For statement is how i should be going about it but I just wanted to check. This is the current code
Sub FindRANumbers()
Dim RA1Range As Range
emptyRow = WorksheetFunction.CountA(Sheet3.Range("A:A")) + 1
Sheet2emptyRow = WorksheetFunction.CountA(Sheet2.Range("H:H"))
'Find Checkbox values and paste them into Sheet 3
Set RA1Range = Sheet2.Cells.Find("RA0001")
Set RA1Check = Sheet3.Cells.Find("RA0001")
If Not RA1Check Is Nothing Then
ElseIf Not RA1Range Is Nothing Then
Sheet3.Cells(emptyRow, 1).MergeArea.Value = "RA0001"
End If
End Sub
It needs to loop through as many rows as are in Sheet2 H:H.
I am not very well versed in For loops but when I this, I still need to run the code multiple times
For i = 1 To Sheet2emptyrow
'Above code here'
Next i
I feel like i am missing something quite simple
Thank you in advance for any help.
EDIT:
I think my description of the problem is a little poor so I have attached an Image to show what i am trying to do
So I want to loop through as many cells that are filled here in Sheet 2 and run my code for each loop
I hope that makes more sense? Sorry about this, But thank you for your help
Using the example of Range.Find Method (Excel) this code finds with a For Loop.
However, remember that if you are working with a large Workbook, it is not the fastest way of searching. Here is a performance test
And do you really have to search on the entire Sheet3? Because it makes it really sloooow. Assuming Sheet2 Column H are the reference values, so you search it on the entire Sheet3.
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "H").End(xlUp).Row
For I = 8 To lastrow
Set c = Sheet2.Cells(I, 8)
With Sheet3
Set cellFound = .Find(what:=c, LookIn:=xlValues, MatchCase:=False)
If Not cellFound Is Nothing Then
FirstAddress = cellFound.Address
Do
'When value is found do something here
Debug.Print cellFound.Address 'To print the addresses of cells found
Set cellFound = .FindNext(cellFound)
Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
End If
End With
Next I
Exaplaining the code
LastRow of Column H
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "H").End(xlUp).Row
For loop from line 8 to lastrow of column H of Sheet2
For I = 8 To lastrow
Next I
The value to search, so using the variable I to loop through all rows
Set c = Sheet2.Cells(I, 8)
Range of search
With Sheet3
End With
Find, using the example of .Find Method
Set cellFound = .Find(what:=c, LookIn:=xlValues, MatchCase:=False)
If Not cellFound Is Nothing Then
FirstAddress = cellFound.Address
Do
'When value is found do something here
Debug.Print cellFound.Address 'To print the addresses of cells found
Set cellFound = .FindNext(cellFound)
Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
End If
I am attempting to find duplicated values and in a column in excel and put 3 values in the corresponding columns next to the item. The problem I am struggling with is that my search range is finding the same range over and over again rather than moving on to the next range that's found to contain the string or setting the replaceValuesRange to Nothing.
I subsequently decided to change the string value to MainInputSHeet.Cells(loopCounter, 4).Value = findString & " FOUND" in an attempt to change the value of the string, but I still get stuck in the find loop, which I assume is because the string is still existing within the cell.
Any ideas? The issue exists in the Do Until Loop. Everything else is working fine
This is what the immediate window looks like iterating through the DoLoop:
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
Main code block
Option Explicit
Public Const DIR_SDR_PRODUCT_DEFINITIONS_FILEPATH As String = "U:\Research_Dev Docs\DevFolder\SDR Sheet\SDRProductDefinitionsICE.xlsx"
Public Sub TranslateAndPullProductInformation()
Dim lastRow As Integer, loopCounter As Integer
Dim sdrICEDefinitions As Workbook
Dim DefinitionsSheet As Worksheet
Dim findString As String, productTypeString As String, marketTypeString As String, contractTypeString As String
Dim searchRange As Range, findValuesRange As Range, replaceValuesRange As Range
'Checks file exists in specificed path, assigns workbook name, assigns proper worksheet for information definitions
If Len(Dir(DIR_SDR_PRODUCT_DEFINITIONS_FILEPATH)) = 0 Then GoTo BAIL_OUT
Set sdrICEDefinitions = Workbooks.Open(DIR_SDR_PRODUCT_DEFINITIONS_FILEPATH)
Set DefinitionsSheet = sdrICEDefinitions.Sheets(1)
Set searchRange = DefinitionsSheet.Range("A:A")
lastRow = MainInputSheet.Cells(MainInputSheet.Rows.Count, "D").End(xlUp).Row
For loopCounter = 2 To lastRow
If IsEmpty(MainInputSheet.Cells(loopCounter, 3)) = True Then
findString = MainInputSheet.Cells(loopCounter, 4).Value
Set findValuesRange = searchRange.Find(findString)
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).Find(findString)
Do Until replaceValuesRange Is Nothing
'Product Name
MainInputSheet.Cells(loopCounter, 1) = findValuesRange.Offset(0, 1).Value
'Market Type
MainInputSheet.Cells(loopCounter, 2) = findValuesRange.Offset(0, 2).Value
'Contract Type
MainInputSheet.Cells(loopCounter, 3) = findValuesRange.Offset(0, 3).Value
MainInputSheet.Cells(loopCounter, 4).Value = findString & " FOUND"
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext
Debug.Print replaceValuesRange.Address
Loop
End If
Next
Exit Sub
BAIL_OUT:
MsgBox ("ProductDefinitions File not found")
End Sub
Your problem is, that
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext
will start searching from the begging every time. To continue searching (show next occurrence of searched value) you have to use:
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext(replaceValuesRange)
Now the problem is, that the Do Until loop will go infinitely, but for every cell with searched value. I am not sure if there is some smarter way to stop the loop, but I just save row number of first found cell to fstRow variable, and then change StopStop variable for True when the loop will find this first cell once more:
Dim StopStop As Boolean
Dim fstRow As Long
StopStop = False
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).Find(findString)
If Not replaceValuesRange Is Nothing Then fstRow = replaceValuesRange.Row
Do Until replaceValuesRange Is Nothing Or StopStop
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext(replaceValuesRange)
If replaceValuesRange.Row = fstRow Then StopStop = True
Loop
I wrote an article recently about Find, but it's in Portuguese, I think it won't help you.
In that article I've put an example code, which you can study and understand how it does work:
Sub FindTest()
Dim Interval As Range
Dim Value As String
Dim Result As Range
Dim PreviousResult As Range
Set Interval = Range("A1:A1000")
Value = "Pedro*"
Set Result = Intervalo.Find(Value, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If Result Is Nothing Then
Debug.Print "Value not found"
Exit Sub
End If
Do
Debug.Print Result.Value
Set PreviousResult = Result
Set Result = Interval.Find(Value, After:=PreviousResult, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
Loop Until Result.Row < PreviousResult.Row
End Sub
It is a good idea to read Find documentation to understand each parameter. I hope that it helps you.
It looks to me like your problem is that you have set replaceValuesRange as a range object. You then use the do loop to run until that range is nothing. The problem is that the range is still an object and will stay an object until you do something else to that variable. I would change this to another for loop and iterate through the range.
Maybe something like
for i = 2 to lastrow 'your variable range starts at row 2 and goes until the last row.
code here
next i
I have a code where there could be an instance of "Apple - Total", but it is very rare, while there will always be an instance of "Apple". How could I create a code to check whether the string exists in a row? The problem is at the moment is that the code bugs out if it is not there. If there is an instance of "Apple - Total" it should take priority over just "Apple". Something like the Try function in R would work.
If WorksheetFunction.Match(Apple & "-Total", Sheets("SOFP").Range("2:2"), 0) > 0 Then
letr = WorksheetFunction.Match(Fund & "-Total", Sheets("SOFP").Range("2:2"), 0)
letr = Split(Cells(, letr).Address, "$")(1)
cur = Sheets("SOFP").Offset(1, 0).Value
ElseIf WorksheetFunction.Match(Apple , Sheets("SOFP").Range("2:2"), 0) > 0 Then
letr = WorksheetFunction.Match(Fund, Sheets("SOFP").Range("2:2"), 0)
letr = Split(Cells(, letr).Address, "$")(1)
cur = Trim(Sheets("SOFP").Offset(1, 0).Value)
End If
Since:
it's always better :
avoid On Error Resume Next approach
which is quite dangerous and should be limited to a very few cases (like to check for any collection element)
use Match() function of the Application object instead of WorksheetFunction object
because it traps the error into its return value and hence doesn't stop code execution upon possible Match() failure
assuming:
you want to store into cur the value in the row beneath the proper column
"Apple" and "Fund" are two String literals and not String variables
a first approach, following more closely yours, could be the following:
Option Explicit
Sub main()
Dim letr As Variant
Dim cur As Double
With Sheets("SOFP").Range("2:2") '<-- reference your worksheet row 2
If Not IsError(Application.Match("Apple-Total", .Cells, 0)) Then '<-- if there's "Apple-Total"...
letr = Application.Match("Fund-Total", .Cells, 0) '<-- ...then try finding "Fund-Total"
ElseIf Not IsError(Application.Match("Apple", .Cells, 0)) Then '<-- otherwise if there's "Apple"...
letr = Application.Match("Fund", .Cells, 0) '<-- ...then try finding "Fund"
End If
If Not IsError(letr) Then '<-- if the "proper Fund" has been succesfully found...
letr = Split(Cells(, letr).Address, "$")(1) '<-- ...then get "proper Fund" column
cur = Trim(.Range(letr & "2").Value) '<-- and return the value in the 3rd row (i.e. with a row index of 2 with reference to row "2")
End If
End With
End Sub
But you may want to consider the following "Find()" approach:
Option Explicit
Sub main2()
Dim f As Range
Dim cur As Double
With Sheets("SOFP").Range("2:2") '<-- reference your worksheet row 2
If Not .Find(what:="Apple-Total", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) Is Nothing Then '<-- if "Apple-Total" has been found ...
Set f = .Find(what:="Fund-Total", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) '<-- ...then try finding "Fund-Total"
ElseIf Not .Find(what:="Apple", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) Is Nothing Then '<-- otherwise, if "Apple" has been found ...
Set f = .Find(what:="Fund", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) '<-- ...then try finding "Fund"
End If
If Not f Is Nothing Then cur = Trim(f.Offset(1).Value) '<-- if the "proper Fund" has been succesfully found then store the value in row 3 of its corresponding column
End With
End Sub
which I think is much neater
You could also use:
If iserror(application.match)... and handle it that way
On error goto TryApple
' try for total and goto eHandle if found
TryApple:
On error goto eHandle
' try for Apple
eHandle:
The first try for total is like the Try, TryApple is like catch, and eHandle is default
Background: I am writing a macro that copies information from a change log into the matched row within a master file made of several sheets which each contain one table. I have the changes written and working, but need to also include a procedure for when the change request is to add a new row. I have a list in Col A that matches with the request, so I need to search for a matched Col A value within the file, then go to the first blank row in the table (there is a lot of empty space still held within the tables), then copy over the relevant information.
Function AddMatch(LOBID As String) As Range
Dim arrSheets, s As Worksheet, f As Range
Dim addr1 As String
arrSheets = Array("Sheet names all go here")
For Each s In arrSheets
Set s = ActiveWorkbook.Sheets(s)
Set f = s.Columns("A").Find(LOBID, Cells(Rows.Count, "A"), xlValues, xlWhole)
If Not f Is Nothing Then
addr1 = f.Address()
Do
Set AddMatch = f.EntireRow
Exit Function
Set f = s.Columns("A").Find(LOBID, f, xlValues, xlWhole)
Loop While f.Address() <> addr1
End If
Next s
Set AddMatch = Nothing
End Function
I have this function which finds me the row within the sheets where LOBID is a match. It may be overcomplicated, but I used the same function with two criteria for another action so it was an easy copy-paste. I need to act upon the first blank row within the table where that match was found, which is where I'll be adding the new information (copied from the change log).
This returns the first row with a match in Col A.
Set destRNG = AddMatch(CStr(changeWS.Cells(i, "A")))
I have a feeling there's a very simple addition to get me from this row to the first blank within the table, but I keep getting a Method 'Range' of object'_Global' error on just about everything I've tried. Is there a simpler way to do this? Thank you in advance for your help.
FOLLOW-UP: Trying to copy a range from the change log to the new row. This throws a Method 'Range' of object'_Global' error, not sure how to adjust it to work.
rw.Range(Cells(1, 1), Cells(1, 10)) = changeWS.Range(Cells(i, 1), Cells(i, 10))
Something like this:
Sub Tester()
Dim rw As Range
Set rw = FirstEmptyRow("AAA")
If Not rw Is Nothing Then
Debug.Print "Found empty row on " & rw.Parent.Name, rw.Address()
Else
Debug.Print "Not found..."
End If
End Sub
Function FirstEmptyRow(LOBID As String) As Range
Dim arrSheets, s, rv As Range
arrSheets = Array("Sheet1", "Sheet2", "Sheet3")
For Each s In arrSheets
Set s = ActiveWorkbook.Sheets(s)
'any match on this sheet?
If Not IsError(Application.Match(LOBID, s.Columns("A"), 0)) Then
Set rv = s.Rows(2) 'start here and work down...
Do While Application.CountA(rv) > 0
Set rv = rv.Offset(1, 0)
Loop
Exit For
End If
Next s
Set FirstEmptyRow = rv
End Function
EDIT:
rw.Range(Cells(1, 1), Cells(1, 10)) = changeWS.Range(Cells(i, 1), Cells(i, 10))
Here you have a problem because Cells() without a worksheet qualifier always points to the ActiveSheet, so you're essentially trying to create a range across multiple sheets, hence the error.
rw.Range(rw.Cells(1, 1), rw.Cells(1, 10)).Value = _
changeWS.Range(changeWS.Cells(i, 1), changeWS.Cells(i, 10)).Value
would be more correct, but I would prefer this type of approach:
rw.Cells(1, 1).Resize(1, 10).Value = changeWS.Cells(i, 1).resize(i, 10).Value
I am trying to find the matching cell value in a named range in my excel workbook (.vba). I know the value that I am looking for, and also know the name of the range, and when I run the code the first time it runs with no problem, but on the second run with a new range name, I get an error.
I have tried a couple different ways to search the named range, and both ways result with the same error. The error is: "Method 'Range' of object '_Global' failed".
My initial code that I tried is:
'march through the list of racks
For i = iFirstRackRow To iLastRackRow
iCurrRackSize = Sheets("PLC I-O").Cells(i, 6).value
iHardwareIndexEnd = iHardwareIndex + iCurrRackSize - 1
rngCardsName = Trim(Sheets("PLC I-O").Cells(i, 2).value & "Cards")
'march through the rack hardware
For j = iHardwareIndex To iHardwareIndexEnd
modCardSize = 0
'march through each card in the rack
For Each zCell In Range(rngCardsName)
If zCell = Sheets("PLC I-O").Cells(j, 2) Then
modCardSize = Sheets("Links").Cells(zCell.Row, zCell.Column + 1).value
Exit For
End If
Next zCell
If modCardSize <> 0 Then
'io module matched
NumRows = NumRows + modCardSize
Else
'processor or adapter module found
NumRows = NumRows + 1
End If
Next
iHardwareIndex = iHardwareIndex + iCurrRackSize
Next
Or I have also tried:
Dim rngFoundCell As Range
With Range(rngCardsName)
Set rngFoundCell = .Find(What:=Sheets("PLC I-O").Cells(j, 2).value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngFoundCell Is Nothing Then
'cell match was found
rngrow = rngFoundCell.Row
rngcol = rngFoundCell.Column
modCardSize = Sheets("Links").Cells(rngrow, rngcol + 1).value
Else
'cell match was not found
End If
End With
I am not sure what I am doing wrong here. Please help.
I think that the problem is the After:= parameter of your .Find . Try to change the parameter with the value After:=.Cells(1).
Thanks everyone! I found this issue. It was the Trim instruction. Since there were multiple spaces in the Sheets("PLC I-O").Cells(i,2).value, I needed to use a custom function to make sure all spaces were removed.