I am looping through a column with ~5000 rows looking for a specific unique record. Once found, I offset and replace it with a value from a range. This is naturally rather resource intensive and I found it to occasionally freeze older machines running the macro.
My idea is now to replace this with a Search & Replace macro but am wondering if the performance is actually faster since the process of checking each cell in range for a value would still be the same?
Here the code I have so far. How would a Search & Replace look like and is worth it?
Sub Replace_List()
Dim rList As Range, cel As Range, n As Long
Dim fnd As Range
Dim fndFirst As String
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Settings")
Set rList = .Range("D4", .Range("D" & .Rows.Count).End(xlUp))
End With
For Each cel In rList
Set fnd = ThisWorkbook.Worksheets("Data").Columns("A:A").Find(What:=cel.Value, LookAt:=xlWhole)
If Not fnd Is Nothing Then
fndFirst = fnd.Address
Do
fnd.Offset(0, 1).Value = cel.Offset(0, 2).Value
Set fnd = ThisWorkbook.Worksheets("Data").Columns("A:A").FindNext(After:=fnd)
Loop While fnd.Address <> fndFirst
End If
Next
Application.ScreenUpdating = True
MsgBox "Replaced all items from the list.", vbInformation, "Replacements Complete"
End Sub
Note: This is not an answer, but rather something to ponder, and takes up way too much room for a comment.
This is pretty much the format I use on a "Search and Replace". I'm not sure if this ends up being any faster or not, but as you can see, it's not too different from your "find" statement. For me it works fine, but I'm not looking at thousands of records. Hope this helps you make a decision.
ThisWorkbook.Worksheets("Data").Columns("A:A").Replace What:=myValue1, Replacement:=myValue2, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Related
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!
I'm looking to create an IF/Else statment in VBA that when run will return a True or False value based on if a cell contains a certain string of text. So basically I want a True value returned if the cell contains the specified string or a False value if it does not contain the specified string. This formula needs to run down a range of cells not just one if that makes a difference. I'm thinking I need to use the InStr function, but I'm not 100% sure if that is correct or how to implement it. I am fairly new to VBA so any help I can get would be greatly appreciated as I have been stuck on this for several hours.
Thank You
Well this is a very badly asked question but I think everyone has needed some help at some point in life. That being said, here is the code you are asking for
Sub FindString()
'Declare the range
Dim rng As Range
'Assign the range to find
Set rng = ActiveSheet.Range("A1:A100")
'Loop though each cell
For Each cell In rng.Cells
'Check if cell has the string and set text
'of the next column to True or False
cell.Offset(0, 1).Value = IIf(InStr(1, cell, "stringToFind"), "True", "False")
Next
End Sub
Give it a try and let me know your comments
Why use VBA? An expression in cell can return True/False.
=ISNUMBER(FIND("something",A1))
I tested #3vts code and it runs but the output is wrong. This version works:
Sub FindString()
Dim rng As Range
Set rng = ActiveSheet.Range("A1:A100")
For Each cell In rng.Cells
If InStr(1, cell, "text to find") > 0 Then
cell.Offset(0, 1).Value = True
Else
cell.Offset(0, 1).Value = False
End If
Next
End Sub
I certainly hope you learned something in spite of the work was done for you.
May be the below one can help you, It gives you whether the excel contains the Word.
Dim ra As Range
Set ra = Cells.Find(What:=Word, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
'False (Not Found)
Else
'True (Found)
End If
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!
First, my code (below) works, but I am trying to see if it can be simplified. The macro in which this code is located will have a lot of specific search items and I want to make it as efficient as possible.
It is searching for records with a specific category (in this case "Chemistry") then copying those records into another workbook. I feel like using Activate in the search, and using Select when moving to the next cell are taking too much time and resources, but I don't know how to code it to where it doesn't have to do that.
Here are the specifics:
Search column T for "Chemistry"
Once it finds "Chemistry", set that row as the "top" record. e.g. A65
Move to the next row down, and if that cell contains "Chemistry", move to the next row (the cells that contain "Chemistry" will all be together"
Keep going until it doesn't find "Chemistry", then move up one row
Set that row for the "bottom" record. e.g. AX128
Combine the top and bottom rows to get the range to select. e.g. A65:AX128
Copy that range and paste it into another workbook
Here is the code:
'find "Chemistry"
Range("T1").Select
Cells.Find(What:="Chemistry", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'set top row for selection
toprow = ActiveCell.Row
topcellselect = "A" & toprow
'find all rows for Chemistry
Do While ActiveCell = "Chemistry"
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
'set bottom row for selection
bottomrow = ActiveCell.Row
bottomcellselect = "AX" & bottomrow
'define selection range from top and bottom rows
selectionrange = topcellselect & ":" & bottomcellselect
'copy selection range
Range(selectionrange).Copy
'paste into appropriate sheet
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial
Thanks in advance for any help!
You never need to select or activate unless that's really what you want to do (at the end of the code, if you want the user to see a certain range selected). To remove them, just take out the activations and selections, and put the things on the same line. Example:
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial
Becomes
wb1.Sheets("Chemistry").Range("A2").PasteSpecial
For the whole code; I just loop thorugh the column and see where it starts and stops being "chemistry". I put it in a Sub so you only have to call the sub, saying which word you're looking for and where to Paste it.
Sub tester
Call Paster("Chemistry", "A2")
End sub
Sub Paster(searchWord as string, rngPaste as string)
Dim i as integer
Dim startRange as integer , endRange as integer
Dim rng as Range
With wb1.Sheets("Chemistry")
For i = 1 to .Cells(Rows.Count,20).End(XlUp).Row
If .Range("T" & i ) = searchWord then 'Here it notes the row where we first find the search word
startRange = i
Do until .Range("T" & i ) <> searchWord
i = i + 1 'Here it notes the first time it stops being that search word
Loop
endRange = i - 1 'Backtracking by 1 because it does it once too many times
Exit for
End if
Next
'Your range goes from startRange to endRange now
set rng = .Range("T" & startRange & ":T" & endRange)
rng.Copy
.Range(rngPaste).PasteSpecial 'Paste it to the address you gave as a String
End with
End sub
As you can see I put the long worksheet reference in a With to shorten it. If you have any questions or if it doesn't work, write it in comments (I haven't tested)
The most efficient way is to create a Temporary Custom Sort Order and apply it to your table.
Sub MoveSearchWordToTop(KeyWord As String)
Dim DestinationWorkSheet As Workbook
Dim SortKey As Range, rList As Range
Set SortKey = Range("T1")
Set rList = SortKey.CurrentRegion
Application.AddCustomList Array(KeyWord)
rList.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Application.DeleteCustomList Application.CustomListCount
Set DestinationWorkSheet = Workbooks("Some Other Workbook.xlsx").Worksheets("Sheet1")
rList.Copy DestinationWorkSheet.Range("A1")
End Sub
I have a spreadsheet with a good amount of data (more than 100,000 rows with columns a-h).
I know twenty or more distinct values in Column F are wrong and I know what they should be. For example, every occurrence of "pif" should be "pig" and "coe" should be "cow", etc.
(Note that there are multiple incorrect values (i.e. multiple "pif"s) for each.)
I'm currently building a macro to go through and fix these individually, and that part works:
Sub FixColumnF()
ActiveSheet.Columns("F").Replace What:= _
"pif", _
Replacement:="pig", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
ActiveSheet.Columns("F").Replace What:= _
"coe", _
Replacement:="cow", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
...
End Sub
My problem is that column A is used to keep track of errors, one of which is an incorrect value in column F. How do I erase the value in column A to indicate there is no longer an error for each row where the value in column F is fixed?
I'm extremely new to vba, so any help would be very much appreciated!
Siddharth posted his suggestions while I was testing/typing mine. My first suggestion is a simple variation of his first suggestion and offers no advantage that I can see. However, my second suggestion is different from either of his suggestions and may be appropriate.
You need to loop for each occurrence of "pif" and "coe" if you want to do something extra with each faulty value found. The code below shows how to replace every occurrence of "pif" by "pig" and then do something with column "A". If you like this technique, you would need to duplicate this code for "coe" and "cow".
Option Explicit
Sub ReplaceFaultyA()
Dim Rng As Range
' It is best to avoid "ActiveSheet" in case the use has called the
' macro with the wrong worksheet active. Probably this is not likely
' in this case but I like to follow good practice even if it not not
' necessary
With Worksheets("Data")
Do While True
' Are you sure all your Find parameters are correct? For example,
' "LookAt:=xlPart" means than "pif" in the middle of a word will
' be replaced by "pig". "LookAt:=xlWhole" may better match your
' requirement. I suggest you look up the specification of Find
' and consider the implications of each parameter.
Set Rng = .Columns("F").Find(What:="pif")
If Rng Is Nothing Then
' No [more] occurrences of "pif" in column F
Exit Do
Else
' Occurrences of "pif" found in column F
.Cells(Rng.Row, "F") = "pig"
' Amend column ""A" of Rng.Row as necessary
End If
Loop
End With
End Sub
Duplication my loop and replacing "pif" and "pig" by "coe" and "cow" in the duplicate is probably the simpliest solution if there are only two replacements. However, if there are many replacements, the technique below may be a better choice.
In this code, I place the faulty values and the matching good values in arrays. With this approach, one block of replacement code can handle an indefinite number of replacements providing the action for column A is the same for each replacement.
Sub ReplaceFaultyB()
Dim InxValue As Long
Dim Rng As Range
Dim ValueFaulty() As Variant
Dim ValueGood() As Variant
' The code below assumes there same number of entries in both arrays.
' You can add extra entries to the two arrays as necessary.
' This assumes the action for column "A" is the same for each faulty value
ValueFaulty = Array("pif", "coe", "appme")
ValueGood = Array("pig", "cow", "apple")
With Worksheets("Data")
For InxValue = LBound(ValueFaulty) To UBound(ValueFaulty)
Do While True
Set Rng = .Columns("F").Find(What:=ValueFaulty(InxValue))
If Rng Is Nothing Then
' No [more] occurrences of this faulty value in column F
Exit Do
Else
' Occurrences of faulty value found in column F
.Cells(Rng.Row, "F") = ValueGood(InxValue)
' Amend column ""A" of Rng.Row as necessary
End If
Loop
Next InxValue
End With
End Sub
There are two ways that I can think of.
Way 1
Use .Find/.FindNext to loop though all the cells which have say the word "pif". In that loop not only replace the word but also edit the value in Col A. For example (Untested)
Sub Sample()
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, FoundAt As String
On Error GoTo Whoa
Set ws = Worksheets("Sheet1")
Set oRange = ws.Columns(5) '<~~ Column 5
SearchString = "pif"
NewString = "pig"
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
'~~> Change value in Cell F
aCell.Value = Replace(aCell.Value, SearchString, NewString)
'~~> Change value in Cell A
aCell.Offset(, -5).Value = "Rectified"
Do
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
aCell.Value = Replace(aCell.Value, SearchString, NewString)
aCell.Offset(, -5).Value = "Rectified"
Else
Exit Do
End If
Loop
End If
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Way 2
Use Autofilter to filter Col F on the word "pif". Loop though all the cells in Col A and add the relevant message. Remove Autofilter and then run your original code (mentioned in your question) to do the replace in Col F. see THIS link on how to use Autofilter.