I have a working code to find a specific string in a column of a specific sheet, offset and clear the contents of a specific cell. However it only clears the first occurrence of this search and I would like to have the code work on all occurrences. Can someone help me to wrap a Loop or a FindNext around this code because I wasn't able to. Please see here below the code I already have. Thnx
Dim SearchValue6 As String 'located B9
Dim Action6 As Range 'clear
SearchValue6 = Workbooks.Open("C:\Users\.......xlsm").Worksheets("Sheet1").Range("B9").Value
On Error Resume Next
Worksheets(2).Columns("A:A").Select
Set Action6 = Selection.Find(What:=SearchValue6, After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Action6 Is Nothing Then
'MsgBox "No clearings made in " & ActiveWorkbook.Name
Else
Action6.Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.ClearContents
End If
Please, try using the next updated code and send some feedback:
Sub FindMultipleTimes()
Dim SearchValue6 As String 'located B9
Dim Action6 As Range 'clear
SearchValue6 = Workbooks.Open("C:\Users\.......xlsm").Worksheets("Sheet1").Range("B9").Value
Dim ws As Worksheet: Set ws = Worksheets(2)
Dim firstAddress As String
Set Action6 = ws.Columns("A:A").Find(What:=SearchValue6, After:=ws.Range("A1"), LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Action6 Is Nothing Then
firstAddress = Action6.address
Do
Action6.Offset(0, 1).ClearContents
Set Action6 = ws.Columns("A:A").FindNext(Action6) 'find the next occurrence
Loop While Action6.address <> firstAddress
Else
MsgBox SearchValue6 & " could not be found in column ""A:A"" of sheet " & ws.name
End If
End Sub
I only adapted your code, but do you want letting the workbook necessary to extract SearchValue6 value, open?
Related
I know selection is not good to use. However, I need to find a string in another sheet and need it to be selected (it can even select and change the color) so the user will able to see it.
My code is only taking me to the sheet but not to the cell where the string I need to find is.
Sub Risk1()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchString = "1."
Application.FindFormat.Clear
Sheet2.Activate
' loop through all sheets
For Each sh In ActiveWorkbook.Worksheets
' Find first instance on sheet
Set cl = sh.Cells.Find(What:=SearchString, _
After:=sh.Cells(1, 1), _
LookIn:=xlValues, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
FirstFound = cl.Activate.cell
End If
Next
End Sub
The string that I am looking for can be in any cell of column A.
Try this. If it's in one sheet no need to loop through all of them. It's still not clear to me what happens if the value is found more than once?
Btw you don't need VBA for this, the worksheet Find will do exactly this.
Sub Risk1()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchString = "1."
Application.FindFormat.Clear
With Sheets("Over").Columns(1)
Set cl = .Find(What:=SearchString, After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cl Is Nothing Then Application.Goto cl 'better than select or activate and sheet does not need to be active first
End With
End Sub
How do I get cell address using Find function.
Here's the code
Dim Found As Range
Set Found = Worksheets("Sheet 1").Cells.Find(What:="test", LookAt:=xlWhole, MatchCase:=True)
If Not Found Is Nothing Then
' do something
End If
When I debug the code, "Found" variable contain a "string" instead of cell address.
It seems you can just use found.address even though it shows as string. The below code worked for me.
Sub findCellAddress()
Dim ra As Range
Set ra = Cells.Find(What:="fff", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Not found")
Else
MsgBox (ra.Address)
End If
End Sub
I could not find this anywhere on the internet.
This code will give you the row and the column.
Dim ThisPos As Range
With Range("A1:J100")
Set ThisPos = .Find(What:="List_Position", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not ThisPos Is Nothing Then
Cell_Add = Split(ThisPos.Address, "$")
ThisRow = Cell_Add(1)
ThisCol = Cell_Add(2)
End If
End With
This code will give you reference style of the cell address.
Dim SValue As Range
With Range("D1:D100")
Set SValue = .Find(What:="Searched Value", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not SValue Is Nothing Then
Cell_Split_R = Split(SValue.Address(ReferenceStyle:=xlR1C1), "R")
Cell_Split_C = Split(Cell_Split_R(1), "C")
SCol = Cell_Split_C(0)
SRow = Cell_Split_C(1)
End If
End With
Goal:
Search Sheet1 for keywords in column 18 (keywords:case,etc.)
Once keyword is found, offset (0,-11)
enter the given value C1008 in respective cell.
and repeat the same till it completes full column (about 1500 rows)
I am not able to perform 4th step.
And I need multiple keywords to search and perform the same steps.
Program:
Sub RCIM()
Dim ws As Worksheet
Dim aCell As Range
Range("A1").Select
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set aCell = .Columns(18).Find(What:="case", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Offset(0, -10).Value = "C1008"
Else
MsgBox "Not Found"
End If
End With
End Sub
If you want just to repeat your code use a loop statement like this:
Sub RCIM()
Dim ws As Worksheet
Dim aCell As Range
DIM isTimetoExit As Boolean
Dim currentRow As Long 'Counter of Rows
Dim KeyWord as String
Range("A1").Select
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
isTimetoExit = False
currentRow = 1 'If you start from row 1
KeyWord = "case"
DO
'
Set aCell = .Columns(18).Find(What:=KeyWord, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Offset(0, -10).Value = "C1008"
Else
MsgBox "Not Found"
End If
'
' Whit a condition go out of loop
isTimetoExit = NOT (Trim(.Cells(currentRow, 1).Value & "") = "")
If (isTimetoExit) THEN EXIT DO
'Go for next row
currentRow = currentRow + 1
' And set the keyword to your new value;
KeyWord = "next case" 'But I don't know where are those KeyWords stroes !?
LOOP
End With
End Sub
I am trying to move the first instances of each value of the column "firstname" from one sheet to another. I am able to move the first instance of the first cell value from the firstname column, but I am not able to move the next and so on till the end. Below is the code I am working with at the moment.
Is there any problem with the for loops?
Option Explicit
Private Const RAW_DATA_SHEET = "UserDetails"
Private Const REPORT_SHEET = "Report"
Private Const USER_NAME_COL = "User Name"
Private Const FIRST_NAME_COL = "First Name"
Private Const LAST_NAME_COL = "Last Name"
Private Sub CommandButton1_Click()
Dim firstname As String
Dim firstnameActive As Range
Dim sheet As Worksheet
Dim sheetre As Worksheet
Dim userNameHeader As Range
Dim firstnameHeader As Range
Dim userToFindRow As Range
Dim user As String
Dim curcell As Range
Application.ScreenUpdating = False
Set sheetre = Sheets("Report")
Set sheet = Sheets("UserDetails")
For Each firstnameHeader In sheet.Range("B2" & sheet.Range("B" & sheet.Cells.Rows.Count).End(xlUp).row)
Set curcell = sheetre.Range("A3")
' Find the columns of "User Name"
Set userNameHeader = sheet.Rows(1).Find(What:=USER_NAME_COL, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) 'note: SearchOrder:=xlByColumns
Set firstnameHeader = sheet.Rows(1).Find(What:=FIRST_NAME_COL, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) 'note: SearchOrder:=xlByColumns
' Use to find the row number of the provided user
Set userToFindRow = sheet.Columns(userNameHeader.Column).Find(What:=user, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) 'note: SearchOrder:=xlByRows
For Each userToFindRow In sheet.Range("E2" & sheet.Range("E" & sheet.Cells.Rows.Count).End(xlUp).row)
' Get the value of "firstname" cell for provided user
Set firstnameActive = sheet.Cells(userToFindRow.Column, firstnameHeader.Column)
If Not IsEmpty(firstnameActive) Then
curcell.Value = firstnameActive
Set curcell = curcell.Offset(1)
End If
Next userToFindRow
Next firstnameHeader
Application.ScreenUpdating = True
End Sub
why the loop is not working?
Sathak, I think you need to change your For Each Loop. Syntax of For each is we tend to search in defined range. You need to add :B & :E in both for each range to make loop work.
Check the modified code and try to use this For Each loop in your code:
First For each loop:
For Each firstnameHeader In sheet.Range("B2:B" & sheet.Range("B" & sheet.Cells.Rows.Count).End(xlUp).Row)
Second For each loop:
For Each userToFindRow In sheet.Range("E2:E" & sheet.Range("E" & sheet.Cells.Rows.Count).End(xlUp).Row)
I have created this macro code using the record function.
Sub Macro1()
Cells.Find(What:="Text to find", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range("E5").Select
ActiveCell.FormulaR1C1 = "text to enter"
Range("D6").Select
Cells.Find(What:="Text to find", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range("E9").Select
ActiveCell.FormulaR1C1 = "text to enter"
End Sub
I need this macro to continue through the same column until it cannot find any more instances of the searched for word without it going back to the top of the column.
So it starts in a column, every time it finds a specified word it tabs across 1 column and pastes in a specified word.
It continues to search for the specified word in the same column until it cannot find it without starting at the top of the column.
Hope that makes some sense.
Not sure I understand but I think what your looking for is:
For each cell in columns(4).cells
If cell.value="Text to find" Then Cell.offset(0,1) = "Text to enter"
Next cell
You can use Find and FindNext to do this quickly, ie to:
search column D for the text in StrOld
enter any matches into column E with the text in StrIn
code
Sub Recut()
Dim strAddress As String
Dim StrIn As String
Dim StrOut As String
Dim rng1 As Range
StrOld = "Old"
StrIn = "New"
Set rng1 = Range("D:D").Find(StrOld, , xlFormulas, xlWhole, , , True)
If Not rng1 Is Nothing Then
strAddress = rng1.Address
Do
rng1.Offset(0, 1) = StrIn
Set rng1 = Range("D:D").FindNext(rng1)
Loop While Not rng1 Is Nothing And rng1.Address <> strAddress
End If
End Sub