I am attempting to sum a series of values based on unique identifiers I have isolated using dictionary keys, via the code below:
SearchVar = dictionary.Keys()(v)
Set FoundVar = CurrentPage.Find(What:=SearchVar, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
Set nextVar = CurrentPage.FindNext(FoundVar)
If Not FoundVar Is Nothing Then
Do Until FoundVar = nextVar
tempsum = tempsum + ws.Cells(FoundVar.Row, [ReferenceCell].Column).Value
Set nextVar = CurrentPage.FindNext(nextVar)
Loop
End If
However when I do so, the tempsum stay at 0. I'm certain that the cell reference in the tempsum addition portion is referencing the correct (non-zero) cells. What could be causing this issue?
Editing to add comment from below: The loop will indeed run only once. I modified it to run multiple times if there are multiple values by changing it to
Do until FoundVar.Address = NextVar.Address
but in these cases it doesn't sum the value for the last instance of FoundVar (as the FoundVar and NextVar addresses are the same). Any suggestions on how to have it include the last value as well? I'm thinking it can be done by saying 'Do until FoundVar.Address is Nothing" or so, but not sure on the correct syntax.
Your code has some mistake. Try this code.
Dim FoundVar As Range
Dim strAddress As String
SearchVar = dictionary.Keys()(v)
Set FoundVar = CurrentPage.Find(What:=SearchVar, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
'Set nextVar = CurrentPage.FindNext(FoundVar)
If Not FoundVar Is Nothing Then
strAddress = FoundVar.Address
Do
tempsum = tempsum + ws.Cells(FoundVar.Row, [ReferenceCell].Column).Value
Set FoundVar = CurrentPage.FindNext(FoundVar)
Loop Until strAddress = FoundVar.Address
End If
Related
I need to find a specific word/character (Assume "X" for now) in a column and then look across that particular row to find the cell addresses which have numbers other than "0".
Image of tabel
X could appear multiple times in that particular column and the VBA should pick every instance of that and repeat the check for numbers other than "0".
Eventually, I need a list of cell addresses which are not "0" and on the row with "X" in column one. Best if this could appear in a message box.
Thanks in advance.
Edit: Code that has been tried:
Sub checkx()
Dim searchResult As Range
Dim mismatch As Range
Dim x As Integer
y = 116
Set searchResult = Cells(1, 1).EntireColumn.Find(what:="x", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
Set mismatch = Cells(searchResult, 1).EntireRow.Find(what:="flag", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
firstcheck = searchResult.Address
Do
Cells(y, 1) = searchResult.Row
Cells(y, 2) = mismatch.Row
x = x + 1
Set searchResult = Cells.FindNext(searchResult)
Set mismatch = Cells.FindNext(mismatch)
Loop While Not searchResult Is Nothing And firstcheck <> searchResult.Address
End Sub
.Find can return Nothing so you must check it before using .Address of nothing. See this: VBA Runtime 91 Error
I am trying to search a specific column in Excel (Column K) using the below VBA code but when I run the macro it instead searches the whole sheet instead of the specified column.
The problem is it firstly finds 'mycell1' in an earlier column, i.e. in Column C instead of Column K which I don't want it to do.
I have also tried using 'xlByRows' in the 'Searchorder' which had the same issue.
Would greatly appreciate any help please
Thanks
Range("K:K").Select
Set foundcell1a = Selection.Cells.Find(What:=mycell1, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set foundcell1a = Cells.FindNext
If Not foundcell1a Is Nothing Then
foundcell1a.Activate
End If
Don't use .Select if you can possibly avoid it and most of the time, you can.
Try using With...End With constructs instead. Be as specific as you can with the object you want to operate on.
Sub SearchK()
Dim mycell1
Dim foundcell1a As Range
mycell1 = 1
With ActiveWorkbook.Worksheets("Sheet1").Range("K:K")
Set foundcell1a = .Find(mycell1, .Cells(.Rows.Count, 1))
Set foundcell1a = .FindNext(foundcell1a)
If Not foundcell1a Is Nothing Then
foundcell1a.Activate
End If
End With
End Sub
Without a With...End With, you would have to repeat all the object identifiers so:
Set foundcell1a = .Find(mycell1, .Cells(.Rows.Count, 1))
Would have to be expressed as:
Set foundcell1a = ActiveWorkbook.Worksheets("Sheet1").Range("K:K").Find(mycell1, .Cells(.Rows.Count, 1))
When VBA is evaluating a command it needs to evaluate each property preceding a period (.) every time it encounters it. Using ActiveWorkbook.Worksheets("Sheet1").Range("K:K") gets rid of 4 periods so it runs faster too.
The Set foundcell1a = .Find(mycell1, .Cells(.Rows.Count, 1)) is saying find mycell1 after the last used cell in column K so it loops back to find the first instance in column K regardless of the active cell.
Try this:
With Range("K:K")
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell1a = Range("K:K").Find(mycell1, LastCell)
If Not FoundCell1a Is Nothing Then
FirstAddr = FoundCell1a.Address
Range(FirstAddr).Activate
End If
Hope this helps!
In my continuing quest for making an easier job out of organizing an on-call schedule for my work place, I've hit another roadbump.
I got really great help with arranging a numbered schedule before that looks like this:
Picture of numbered schedule
Each of those numbers correspond to a specific name on the list in green to the right called "Personal".
Now I want to substitute those numbers with the names on the green list with a loop.
I tried doing it like this, by selecting the range of cells with the numbers and then making a loop to replace all individual numbers with the names in the list:
Sub FindReplaceAllTest(numOfEmployees As Integer)
Dim sht As Worksheet
Dim fnd As Integer
Dim rplc As Variant
fnd = 1
rplc = ThisWorkbook.Sheets("Duty Roster").Cells("17, fnd + 1").Value
For Each sht In ActiveWorkbook.Worksheets
Range("B2:F54").Select
Selection.Replace What:=fnd, replacement:=rplc, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
If fnd < numOfEmployees Then
fnd = fnd + 1
ElseIf fnd = numOfEmployees Then
fnd = 0
End If
Next sht
End Sub
The variable numOfEmployees is gathered in an earlier SUB where the names in the green list are counted and passed on into this variable, this for the sake of the process of creating the numbered list.
Unfortunatly it doesn't yield the desired results. I get error '1004' at the line:
rplc = ThisWorkbook.Sheets("Duty Roster").Cells("17, fnd + 1").Value
This seems to be caused by the fnd variable in that line. When i take out fnd and replace it with a regular row reference I get a result like this:
"Fnd" switched out for "2": "rplc = ThisWorkbook.Sheets("Duty Roster").Cells("17, 2").Value"
Even though I put "2" in the row I still get the name of the list as a substitute.
The correct sintax is the following
rplc = ThisWorkbook.Sheets("Duty Roster").Cells(17, fnd + 1).Value
Which will get you the value of cell in column "fnd+1" and row 17
Furthermore you're looping through sheets but never actually use them since you neither use "sht" nor prefix any range object with a "dot" to refer it to the "ruling" sht. Like follows:
For Each sht In ActiveWorkbook.Worksheets
sht.Range("B2:F54").Replace What:=fnd, replacement:=rplc, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Coming from this:
Schedule before numbers been replaced by the green list of employees
This code:
Sub FindReplaceAllTest(numOfEmployees As Integer)
Dim n As Integer
Dim fnd As Integer
Dim rplc As String
fnd = 1
Do Until n = numOfEmployees + 1
rplc = ThisWorkbook.Sheets("Duty Roster").Cells(fnd + 1, 17).Value
Range("B2:F54").Select
Selection.Replace What:=fnd, replacement:=rplc, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False,_
SearchFormat:=False, ReplaceFormat:=False
n = n + 1
fnd = fnd + 1
Loop
End Sub
Produced these results:
Schedule after numbers been replaced by the green list of employees
Many thanks to user3598756 for providing me with what I needed to solve this! She/He pointed out that I was writing parts in my code I did'nt need so I switched out my For Each Loop with a Do Until Loop and also replaced the sht variable with n (and rewrote them according to my needs) to make it work. He also made me aware that I had mixed up the placement of the column/row references. After editing that as well my code started producing the results I wanted.
So what my code now does is to compare the variable n with the variable numOfEmployees + 1 to make sure the loop stops when n > than numOfEmployees. Making sure all numbers are included. Furthermore the loop looks at fnd within my designated range and switching out all instances of that number with the value in the cell found at the variable rplc.
That's my (I hope correct, I'm fairly new to this) simplified answer to what I've done.
Thanks a bunch for the help!
I am getting this error message when I run the macro:
Run-time error '6': Overflow
I have two worksheets; Search and Data. The 'Data' worksheet contains two columns, column A with numbers I want to search through and column B with an alphanumeric value I want to copy and paste into the 'Search' worksheet when a number match is found. Because a number I am searching for can be listed an unknown number of times I want a macro to loop through to find all of the instances, copy the value to its immediate right and paste it into the 'Search' worksheet in cell D3 and going down a row for multiple instances of the number being found.
The number I am searching for is found in cell B3 on the 'Search' worksheet.
This is a sample of what the 'Data' worksheet looks like:
ID ISS_ID
108143 136KQV4
108143 173HBK3
108143 136KQX0
109728 7805JM1
109706 7805JM1
102791 23252T4
105312 6477LZ6
Here is the code that I have now:
Sub Acct_Search()
Dim searchResult As Range
Dim x As Integer
x = 3
' Search for "Activity" and store in Range
Set searchResult = Worksheets("Data").Range("A1:A3500").Find(What:=Worksheets("Search").Range("B3"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
' Store the address of the first occurrence of this word
firstAddress = searchResult.Address
Do
' Set the value in the O column, using the row number and column number
Worksheets("Search").Cells(x, 4) = searchResult.Offset(0, 1).Value
' Increase the counter to go to the next row
x = x + 1
' Find the next occurrence of "Activity"
Set searchResult = Cells.FindNext(searchResult)
' Check if a value was found and that it is not the first value found
Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address
End Sub
When I Debug it points to the x = x + 1 line. Right now it is able to copy and paste the first value without issue but it is after that point that the error comes into play.
Your problem changed because you are not resetting the origin point of the search with the After:=... parameter of the Range.FindNext Method. Yes, you are passing in searchResult but it was not accepting it as the After:= parameter.
When I ran your code, I was thrown into an infinite loop due to the FindNext always finding the same second instance. This explains the integer coughing at being incremented above 2¹⁵. When it was changed to a long, that gave something else time to choke.
After I changed one line to definitively include the named parameter, everything cleared up.
Set searchResult = Cells.FindNext(After:=searchResult)
This was reproducible simply by adding/removing the parameter designation. It seems that the Cells.FindNext(searchResult) was finding Search!B3 and since that wasn't the firstAddress, it just kept looping on the same Search!B3. It wasn't until I forced after:=searchResult that the .FindNext adjusted itself. It's times like these I think fondly of my C/C++ days without this wallowing overhead.
I've gone through your code and added a With ... End With block that should discourage any questionable parentage.
Sub Acct_Search()
Dim searchResult As Range, firstAddress As String
Dim x As Long, ws As Worksheet
x = 3
Set ws = Worksheets("Search")
' Search for "Activity" and store in Range
With Worksheets("Data").Range("A1:A3500")
Set searchResult = .Find(What:=ws.Range("B3"), LookIn:=xlFormulas, After:=.Cells(.Rows.Count, .Columns.Count), _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
' Store the address of the first occurrence of this word
firstAddress = searchResult.Address
Do
' Set the value in the O column, using the row number and column number
ws.Cells(x, 4) = searchResult.Offset(0, 1).Value
' Increase the counter to go to the next row
x = x + 1
' Find the next occurrence of "Activity"
Set searchResult = .FindNext(After:=searchResult)
'Debug.Print searchResult.Address(0, 0, external:=True)
' Check if a value was found and that it is not the first value found
Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address
End With
Set ws = Nothing
End Sub
I've left the After:= parameter designation in although it is no longer needed.
Change
Dim x As Integer
to
Dim x As Long
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.