This question already has answers here:
Matching similar but not exact text strings in Excel VBA projects
(5 answers)
Closed 5 years ago.
In the above pic i have to search the sap code from sheet 2 to the respective..
By Taking some words like Master/13 or visa/chennai we have match the sapcode from sheet 2..
srchString = "visa/20160927/Chennai/FT"
Set rng = Worksheets("Rulebook_Temp").Cells.find(what:=srchString, After:=ActiveCell, LookIn:=xlFormulas, lookat:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
Its returning empty for me...
All you really need is to remove the date part of the card type in your source and destination and then you could do a simple lookup. If you have a string like a/b/c/d in cell A1, this will return a/c/d
=IF(LEN(A1)-LEN(SUBSTITUTE(A1,"/",""))>2,REPLACE(A1,FIND("/",A1),FIND("/",A1,FIND("/",A1)+1)-FIND("/",A1),""),A1)
It also checks to make sure that there are more than 2 /, so in the case of a/b the value will be left unchanged. This therefore also works with your premium/007 value
you can try this too
use excel arrays
use this to return the rows that contain the code
IF(ISNUMBER(FIND("Master/13",Sheet2!$A$2:$A$50,1)),ROW(Sheet2!$B$2:$B$50))
then use SMALL to return the first row on the sheet 2 where the match was found
SMALL(IF(ISNUMBER(FIND("Master/13",Sheet2!$A$2:$A$50,1)),ROW(Sheet2!$B$2:$B$50)),1)
Then use index to return the value
INDEX(Sheet2!$B$2:$B$50,SMALL(IF(ISNUMBER(FIND("Master/13",Sheet2!$A$2:$A$50,1)),ROW(Sheet2!$B$2:$B$50)),1))
Enter as an array Control + Shift + Enter
This should work I have tested
You can do that by iterating through the cells as follows
Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ThisWorkbook.Sheets(1).Range("A1:A60")
Dim foundString, delimiterStr As String
Dim object() As String
delimiterStr = "||"
Dim n As Integer
For n = 1 To rng.Rows.Count
If CStr(rng.Cells(n, 1).Text) Like "*visa/20160927/Chennai/FT*" Then
foundString = foundString & CStr(rng.Cells(n, 1).Text) & delimiterStr
End If
Next n
object = Split(foundString, delimiterStr)
Dim rng_1 As Range
Set rng_1 = ThisWorkbook.Sheets(1).Range("B1")
Dim i As Integer
For i = LBound(object) To UBound(object)
rng_1.Offset(i + 1, 0).Value = object(i)
Next
End Sub
Related
I need to search all worksheets for the values in Worksheet one column A. The behavior should be similar to a CTRL-F find all selection. In A:1 of every worksheet is a name and if the value from column A is in that worksheet then A:1 will be returned. I do not need VLookup or HLookup. It might be doable with index and search combo, but I am not finding a good way to do that. I know I need an array search of some sort since I need to search everywhere. I have a solution that does not scale and is sloppy on the return. This is the formula I am currently using.
Column A is where the search values are pasted. Columns B-Z or however far is needed get the formula pasted in the first 200 rows which is the limit of the allowed search terms.
{=IF(OR($A2<>""),IF(OR($A2=Sheet26!$A$1:SZ$25000),Sheet26!A$1,"Not Found"),"")}
That is the formula for column Z and the sheet numbers are changed for each column that has a sheet. What I need to adjust this to is only having the formula in column B and it returning a concatenated value of all the names it found. There are lots of questions dealing with just one value or one range like this EXCEL: Need to find a value in a range of cells from another worksheet and return value from adjacent cell but nothing that actually answers what I need.
Currently the result I get is something like this.
A B C D E ...
Star Bob Not Found Ann Not Found
Light Bob Jill Not Found Not Found
378 Not Found Jill Not Found Not Found
What I would like to have is this
A B
Star Bob, Ann
Light Bob, Jill
378 Jill
How can I modify my formula to accomplish that?
Thanks
If you get tired of the formula approach, here is a VBA approach that should do what you describe.
It looks at column 1 on sheet1 to get a list of words to search for
read that list into a vba array (for speed)
for each item in the list, search each worksheet to see if the item exists
I added each item to a Dictionary, and then concatenated the results with commas, but you could also construct a string on the fly, to store in the second "column" of the array
After all is done, we write the results back to the worksheet.
It should be able to handle any reasonable number of worksheets and search terms
If necessary, you can limit the range to search on each worksheet; exclude certain worksheets from being searched; look at partial matches in a cell; select a case-sensitive search; etc.
If there are blank entries between the first and last search terms, I have excluded the search.
Option Explicit
Sub FindAllColA()
Dim WB As Workbook, WS As Worksheet
Dim WS1 As Worksheet
Dim D As Object
Dim V
Dim R As Range
Dim FirstRow As Long, LastRow As Long
Dim I As Long
Set D = CreateObject("scripting.dictionary")
Set WB = ThisWorkbook
Set WS1 = WB.Worksheets("Sheet1")
With WS1
If .Cells(1, 1) <> "" Then
FirstRow = 1
Else
FirstRow = .Cells(1, 1).End(xlDown).Row
End If
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'V will hold both search terms and the results
V = .Range(.Cells(FirstRow, 1), .Cells(LastRow, 1)).Resize(columnsize:=2)
End With
For I = 1 To UBound(V)
If Not V(I, 1) = "" Then
D.RemoveAll
For Each WS In WB.Worksheets
If Not WS.Name = WS1.Name Then
With WS
If Not .Cells.Find(what:=V(I, 1), LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False) Is Nothing Then
D.Add .Cells(1, 1).Text, .Cells(1, 1).Text
End If
End With
End If
Next WS
V(I, 2) = Join(D.Keys, ",")
Else
V(I, 2) = ""
End If
Next I
With WS1
Set R = .Range(.Cells(FirstRow, 1), .Cells(LastRow, 2))
R.EntireColumn.Clear
R = V
R.EntireColumn.AutoFit
End With
End Sub
Another way, would be an UDF which can be used in a wider range without any changes like:
Public Function ValString(search_term As String, cell_string As Variant, ParamArray ignored_sheets()) As Variant
Dim x As Variant
If TypeOf cell_string Is Range Then cell_string = cell_string.Address
If Not TypeOf Evaluate(cell_string) Is Range Then
ValString = CVErr(2023)
Exit Function
ElseIf Range(cell_string).Cells.Count > 1 Then
ValString = CVErr(2023)
Exit Function
End If
If IsMissing(ignored_sheets) Then
ignored_sheets = Array(Application.Caller.Parent.Name)
Else
For x = 0 To UBound(ignored_sheets)
If TypeOf ignored_sheets(x) Is Range Then
ignored_sheets(x) = ignored_sheets(x).Parent.Name
ElseIf TypeName(ignored_sheets(x)) = "String" Or IsNumeric(ignored_sheets(x)) Then
ignored_sheets(x) = Format(ignored_sheets(x), "#")
Else
ignored_sheets(x) = ""
End If
Next
End If
For Each x In ThisWorkbook.Worksheets
If IsError(Application.Match(x.Name, Array(ignored_sheets)(0), 0)) Then
If Not x.Cells.Find(search_term, , -4163, 1, , , True) Is Nothing Then
ValString = ValString & ", " & x.Range(cell_string).Value2
End If
End If
Next
If Len(ValString) Then
ValString = Mid(ValString, 3)
Else
ValString = CVErr(2042)
End If
End Function
Put the code in a Module and you can use it like a normal formula in your sheet.
Example:
=ValString(A1,"A1")
Or for your case:
=IFERROR(ValString(A1,"A1"),"Not Found")
Use: ValString([search_term],[cell_string],{[ignored_sheet1],[ignored_sheet2],...})
[search_term]: the string to look for
[cell_string]: the address of a cell as ref or string which you want to output if found
[ignored_sheets]: (optional) the sheet names as strings or a ref to them you want to ignore
If [ignored_sheets] is omitted the sheet you have the formula in will be ignored. To include all sheets in the workbook simply set it to ""
If nothing was found it will return #N/A! (which is good as you can catch this to set whatever output you want without changing the code)
If [cell_string] is not an address-string and/or goes for multiple cells, it will return #REF!
[ignored_sheets] is used as a list like =ValString(A1,"A1",Sheet1!A1,Sheet5!A1) or =ValString(A1,"A1","Sheet3","Sheet4","Sheet7","MyWhateverSheetName"). If used in the ref-way, you can rename the sheets and it will also in the formula. This is good if there is a summary sheet you do not want to check. But keep in mind: if used, the sheet with the formula itself, also needs to be included!
If you still have any questions, just ask ;)
try this UDF
Function findKeywords(findMe As String) As String
findKeywords = ""
Dim sheetToSkip As String
sheetToSkip = "Sheet1"
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> sheetToSkip And Len(findMe) > 0 Then ' do not look for blank cells
' note: LookAt:=xlWhole ... whole word LookAt:=xlPart ... partial
Dim aaa As Range
Set aaa = sht.Cells.Find( _
What:=findMe, _
After:=sht.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not aaa Is Nothing Then
If Len(findKeywords) = 0 Then
findKeywords = sht.Range("a1")
Else
findKeywords = findKeywords & ", " & sht.Range("a1")
End If
End If
End If
Next sht
' If Len(findKeywords) = 0 Then findKeywords = "Not Found" ' uncomment to return "Not Found" if desired
' Debug.Print findKeywords
End Function
How can I find the last row that contains data in a specific column and on a specific sheet?
How about:
Function GetLastRow(strSheet, strColumn) As Long
Dim MyRange As Range
Set MyRange = Worksheets(strSheet).Range(strColumn & "1")
GetLastRow = Cells(Rows.Count, MyRange.Column).End(xlUp).Row
End Function
Regarding a comment, this will return the row number of the last cell even when only a single cell in the last row has data:
Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
You should use the .End(xlup) but instead of using 65536 you might want to use:
sheetvar.Rows.Count
That way it works for Excel 2007 which I believe has more than 65536 rows
Simple and quick:
Dim lastRow as long
Range("A1").select
lastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
Example use:
cells(lastRow,1)="Ultima Linha, Last Row. Youpi!!!!"
'or
Range("A" & lastRow).Value = "FIM, THE END"
function LastRowIndex(byval w as worksheet, byval col as variant) as long
dim r as range
set r = application.intersect(w.usedrange, w.columns(col))
if not r is nothing then
set r = r.cells(r.cells.count)
if isempty(r.value) then
LastRowIndex = r.end(xlup).row
else
LastRowIndex = r.row
end if
end if
end function
Usage:
? LastRowIndex(ActiveSheet, 5)
? LastRowIndex(ActiveSheet, "AI")
Public Function LastData(rCol As Range) As Range
Set LastData = rCol.Find("*", rCol.Cells(1), , , , xlPrevious)
End Function
Usage: ?lastdata(activecell.EntireColumn).Address
All the solutions relying on built-in behaviors (like .Find and .End) have limitations that are not well-documented (see my other answer for details).
I needed something that:
Finds the last non-empty cell (i.e. that has any formula or value, even if it's an empty string) in a specific column
Relies on primitives with well-defined behavior
Works reliably with autofilters and user modifications
Runs as fast as possible on 10,000 rows (to be run in a Worksheet_Change handler without feeling sluggish)
...with performance not falling off a cliff with accidental data or formatting put at the very end of the sheet (at ~1M rows)
The solution below:
Uses UsedRange to find the upper bound for the row number (to make the search for the true "last row" fast in the common case where it's close to the end of the used range);
Goes backwards to find the row with data in the given column;
...using VBA arrays to avoid accessing each row individually (in case there are many rows in the UsedRange we need to skip)
(No tests, sorry)
' Returns the 1-based row number of the last row having a non-empty value in the given column (0 if the whole column is empty)
Private Function getLastNonblankRowInColumn(ws As Worksheet, colNo As Integer) As Long
' Force Excel to recalculate the "last cell" (the one you land on after CTRL+END) / "used range"
' and get the index of the row containing the "last cell". This is reasonably fast (~1 ms/10000 rows of a used range)
Dim lastRow As Long: lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row - 1 ' 0-based
' Since the "last cell" is not necessarily the one we're looking for (it may be in a different column, have some
' formatting applied but no value, etc), we loop backward from the last row towards the top of the sheet).
Dim wholeRng As Range: Set wholeRng = ws.Columns(colNo)
' Since accessing cells one by one is slower than reading a block of cells into a VBA array and looping through the array,
' we process in chunks of increasing size, starting with 1 cell and doubling the size on each iteration, until MAX_CHUNK_SIZE is reached.
' In pathological cases where Excel thinks all the ~1M rows are in the used range, this will take around 100ms.
' Yet in a normal case where one of the few last rows contains the cell we're looking for, we don't read too many cells.
Const MAX_CHUNK_SIZE = 2 ^ 10 ' (using large chunks gives no performance advantage, but uses more memory)
Dim chunkSize As Long: chunkSize = 1
Dim startOffset As Long: startOffset = lastRow + 1 ' 0-based
Do ' Loop invariant: startOffset>=0 and all rows after startOffset are blank (i.e. wholeRng.Rows(i+1) for i>=startOffset)
startOffset = IIf(startOffset - chunkSize >= 0, startOffset - chunkSize, 0)
' Fill `vals(1 To chunkSize, 1 To 1)` with column's rows indexed `[startOffset+1 .. startOffset+chunkSize]` (1-based, inclusive)
Dim chunkRng As Range: Set chunkRng = wholeRng.Resize(chunkSize).Offset(startOffset)
Dim vals() As Variant
If chunkSize > 1 Then
vals = chunkRng.Value2
Else ' reading a 1-cell range requires special handling <http://www.cpearson.com/excel/ArraysAndRanges.aspx>
ReDim vals(1 To 1, 1 To 1)
vals(1, 1) = chunkRng.Value2
End If
Dim i As Long
For i = UBound(vals, 1) To LBound(vals, 1) Step -1
If Not IsEmpty(vals(i, 1)) Then
getLastNonblankRowInColumn = startOffset + i
Exit Function
End If
Next i
If chunkSize < MAX_CHUNK_SIZE Then chunkSize = chunkSize * 2
Loop While startOffset > 0
getLastNonblankRowInColumn = 0
End Function
Here's a solution for finding the last row, last column, or last cell. It addresses the A1 R1C1 Reference Style dilemma for the column it finds. Wish I could give credit, but can't find/remember where I got it from, so "Thanks!" to whoever it was that posted the original code somewhere out there.
Sub Macro1
Sheets("Sheet1").Select
MsgBox "The last row found is: " & Last(1, ActiveSheet.Cells)
MsgBox "The last column (R1C1) found is: " & Last(2, ActiveSheet.Cells)
MsgBox "The last cell found is: " & Last(3, ActiveSheet.Cells)
MsgBox "The last column (A1) found is: " & Last(4, ActiveSheet.Cells)
End Sub
Function Last(choice As Integer, rng As Range)
' 1 = last row
' 2 = last column (R1C1)
' 3 = last cell
' 4 = last column (A1)
Dim lrw As Long
Dim lcol As Integer
Select Case choice
Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Last = Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
Case 4:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Last = R1C1converter("R1C" & Last, 1)
For i = 1 To Len(Last)
s = Mid(Last, i, 1)
If Not s Like "#" Then s1 = s1 & s
Next i
Last = s1
End Select
End Function
Function R1C1converter(Address As String, Optional R1C1_output As Integer, Optional RefCell As Range) As String
'Converts input address to either A1 or R1C1 style reference relative to RefCell
'If R1C1_output is xlR1C1, then result is R1C1 style reference.
'If R1C1_output is xlA1 (or missing), then return A1 style reference.
'If RefCell is missing, then the address is relative to the active cell
'If there is an error in conversion, the function returns the input Address string
Dim x As Variant
If RefCell Is Nothing Then Set RefCell = ActiveCell
If R1C1_output = xlR1C1 Then
x = Application.ConvertFormula(Address, xlA1, xlR1C1, , RefCell) 'Convert A1 to R1C1
Else
x = Application.ConvertFormula(Address, xlR1C1, xlA1, , RefCell) 'Convert R1C1 to A1
End If
If IsError(x) Then
R1C1converter = Address
Else
'If input address is A1 reference and A1 is requested output, then Application.ConvertFormula
'surrounds the address in single quotes.
If Right(x, 1) = "'" Then
R1C1converter = Mid(x, 2, Len(x) - 2)
Else
x = Application.Substitute(x, "$", "")
R1C1converter = x
End If
End If
End Function
I would like to add one more reliable way using UsedRange to find the last used row:
lastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
Similarly to find the last used column you can see this
Result in Immediate Window:
?Sheet1.UsedRange.Row+Sheet1.UsedRange.Rows.Count-1
21
Public Function GetLastRow(ByVal SheetName As String) As Integer
Dim sht As Worksheet
Dim FirstUsedRow As Integer 'the first row of UsedRange
Dim UsedRows As Integer ' number of rows used
Set sht = Sheets(SheetName)
''UsedRange.Rows.Count for the empty sheet is 1
UsedRows = sht.UsedRange.Rows.Count
FirstUsedRow = sht.UsedRange.Row
GetLastRow = FirstUsedRow + UsedRows - 1
Set sht = Nothing
End Function
sheet.UsedRange.Rows.Count: retrurn number of rows used, not include empty row above the first row used
if row 1 is empty, and the last used row is 10, UsedRange.Rows.Count will return 9, not 10.
This function calculate the first row number of UsedRange plus number of UsedRange rows.
Last_Row = Range("A1").End(xlDown).Row
Just to verify, let's say you want to print the row number of the last row with the data in cell C1.
Range("C1").Select
Last_Row = Range("A1").End(xlDown).Row
ActiveCell.FormulaR1C1 = Last_Row
get last non-empty row using binary search
returns correct value event though there are hidden values
may returns incorrect value if there are empty cells before last non-empty cells (e.g. row 5 is empty, but row 10 is last non-empty row)
Function getLastRow(col As String, ws As Worksheet) As Long
Dim lastNonEmptyRow As Long
lastNonEmptyRow = 1
Dim lastEmptyRow As Long
lastEmptyRow = ws.Rows.Count + 1
Dim nextTestedRow As Long
Do While (lastEmptyRow - lastNonEmptyRow > 1)
nextTestedRow = Application.WorksheetFunction.Ceiling _
(lastNonEmptyRow + (lastEmptyRow - lastNonEmptyRow) / 2, 1)
If (IsEmpty(ws.Range(col & nextTestedRow))) Then
lastEmptyRow = nextTestedRow
Else
lastNonEmptyRow = nextTestedRow
End If
Loop
getLastRow = lastNonEmptyRow
End Function
Function LastRow(rng As Range) As Long
Dim iRowN As Long
Dim iRowI As Long
Dim iColN As Integer
Dim iColI As Integer
iRowN = 0
iColN = rng.Columns.count
For iColI = 1 To iColN
iRowI = rng.Columns(iColI).Offset(65536 - rng.Row, 0).End(xlUp).Row
If iRowI > iRowN Then iRowN = iRowI
Next
LastRow = iRowN
End Function
Sub test()
MsgBox Worksheets("sheet_name").Range("A65536").End(xlUp).Row
End Sub
This is looking for a value in column A because of "A65536".
The first line moves the cursor to the last non-empty row in the column. The second line prints that columns row.
Selection.End(xlDown).Select
MsgBox(ActiveCell.Row)
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 have multiple cells on one row in excel that all contain HTML. Each cell is in a different lang but has the same URLs throughout eg: (...loc=en-uk) I need to find and replace this in each cell but with a different value for each cell eg: find "en-uk" in cell A, Replace with "it-it", mover to next cell, find "en-uk", replace with "es-es" and so on till empty cell is reached.
Had tried the following but it only takes find and replace values from the same 2 cells:
Dim Findtext As String
Dim Replacetext As String
Findtext = Range("B2").Value
Replacetext = Range("C2").Value
Cells.Replace What:=Findtext, Replacement:=Replacetext, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
You will want to use Cells, instead of Range, and loop through the columns using a Variable "lCol".
Range(Column Letter , Row Number) has it's limitations because you are using a letter. It's hard to add 1 to C.. C + 1 = D? So use Cells(row#, col#). That way, you can incrementally work your way through the columns or rows using numbers instead of letters. In this case, the variable is the column, so we will use lCol and loop from 1 to the Last Column Number. Replacing the text from an original source string using your original post as a starting point.
Note: I'm not sure where your original string was. Also, if you know what you are replacing from the original string, and find yourself looking at Row2 being all the same thing across the sheet, you can just set that in your replaceString statement below.
Try This - It's only a few lines, once you take out all the comments.
Sub TextReplace()
Dim sheetName As String
Dim findText As String
Dim replaceText As String
Dim lastCol As Long
Dim lCol As Long
'Set the sheetName here, so you don't have to change it multiple times later
sheetName = "Sheet1"
'Check the Last Column with a value in it in Row 3. Assuming Row 3 has the Replacement text.
lastCol = Sheets(sheetName).Cells(3, Columns.Count).End(xlToLeft).Column
'Assuming you have an original string in a cell. Range("A1"), in this case.
origString = Sheets(sheetName).Cells(1, 1).Value
'Loop through each Column - lCol is going to increase by 1 each time.
'Starting on Column B,since Column A contains your original String.
For lCol = 2 To lastCol
'Using Cells(row#, col#), instead of Range(ColLetter, row#) gives you the ability to loop with lCol.
findText = Sheets(sheetName).Cells(2, lCol).Value
replaceText = Sheets(sheetName).Cells(3, lCol).Value
'Put the value from Range("A1") with the text replaced from Row 2 with Row 3's value.
Sheets(sheetName).Cells(1, lCol) = Replace(origString, findText, replaceText)
Next lCol
End Sub
Edit: Updated Column to start on B, instead of A.
Try this (for row 16 and for row 20 for example):
Sub ReplaceTextinRow()
Dim lastCol, iter
lastCol = ActiveSheet.UsedRange.Columns.Count 'this approach is not always applicable
For iter = 1 To lastCol
'Cells(16, iter).Offset(4, 0).Value = Replace(Cells(16, iter).Value, "en-us", "en-uk")
Cells(20, iter).value = Replace(Cells(20, iter).value, Cells(20, iter).Offset(-4, 0).Value)
Next
End Sub
I have an Excel spreadsheet where I need to amend a specific column.
Step 1. Find the column name
Step 2. Mark the all populated rows in this column
Step 3. Proceed with certain action (mostly find and replace or if other column is “this” then amend my column for “that).
I would like those first 2 steps specified and leave me the space to amend the code easily for proceeding with step 3.
I have VBA code which does a similar job. It searches for the specific column name, it marks all rows populated. It does not allow me to easily copy and paste other code, found on the internet, to the main code.
MACRO WHICH FINDS THE COLUMN NAME AND MARKS ALL RECORDS IN THIS COLUMN
Sub FindAddressColumn()
Dim rngAddress As Range
Set rngAddress = Range("A1:ZZ1").Find("Address")
If rngAddress Is Nothing Then
MsgBox "Address column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
End Sub
Most of macros found on the internet have the column specified.
EXAMPLE OF CODE THAT I WOULD LIKE TO ADD TO THE MAIN CODE:
Sub GOOD_WORKS_Find_Replace_Commas_in_Emails()
Sheets("Data").Activate
Dim i As String
Dim k As String
i = ","
k = "."
Columns("R").Replace What:=i, Replacement:=k, LookAt:=xlPart, MatchCase:=False
Sheets("Automation").Activate
MsgBox "Removing commas in emails - Done!"
End Sub
I believe what I miss is the code which will “say” for the already marked columns rows…. And here you paste only the part of the code found on the internet.
I think this code will do the job you want:
Sub ColumnReplace()
Dim TargetColumn As Range
Dim Header As String
Dim SearchFor As String
Dim ReplaceTo As String
Header = "ccc"
SearchFor = "111"
ReplaceTo = "99999"
Set TargetColumn = ThisWorkbook.ActiveSheet.Range("1:1").Find(Header, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
Set TargetColumn = Cells(1, TargetColumn.Column).EntireColumn
TargetColumn.Replace What:=SearchFor, Replacement:=ReplaceTo, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Adopt Workbook / Sheets names as well as strings for search / replace as you wish.
Sample file: https://www.dropbox.com/s/s7fghhlsmydjaf6/EntireColumnReplace.xlsm