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
Related
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?
Is there a way to search for a value in a list such as in column A, identify the row number of that value (for e.g. it could be Row 40 of Column A), go to a different column (e.g. Row 40, Column B) and then insert data into that column but through the macro (so it is done automatically).
I have tried to play around using the code below but cannot seem to get anywhere;
Dim Cell As Range
Dim RowNumber As Long
Columns("B:B").Select
Set cell = Selection.Find(What:="celda", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
RowNumber = Cell.Row
If cell = "celda" Then
'find row, go to Column B of that row, and insert "abc"
Else
'do it another thing
End If
I found the code above in the link below;
How to find a value in an excel column by vba code Cells.Find (not my own work but props to the creator)
You need little modification to your code. Try below...
Sub FindAndAdd()
Dim fCell As Range
Dim strSearch As String
strSearch = "Harun"
With ActiveSheet
Set fCell = .Columns("A:A").Find(What:=strSearch, _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
'Lookat:=xlWhole to match whole word.
End With
If Not fCell Is Nothing Then
fCell.Offset(0, 1) = "New Value"
Else
MsgBox "No match found.", vbInformation, "Search Result"
End If
End Sub
I am trying to create a dynamic macro in VBA by which I can select a new range starting on a column with the title "Position Number". So my "program" ideally goes to the sheet, finds the range where I want to find this cell that says "Position Number", finds it, gives me the column number (as the column might change) and then it starts on that column to mark a new range and compare it with another sheet. I am so far stuck in the part where I am trying to use the column number I have found to define the new range. I have tried lots of things I found online, but cant fix it.
The error is on:
Set Range1 = Range("'C'& ColNum" & "R1")
I tried a few other variants of this but it does not work or gives me a number as output.
Thanks in advance!
Dim FilledRange As Range
Dim Range1 As Range
Dim Rng As Range
Dim ColNum As String
Worksheets("FILLED Today").Activate
Set FilledRange = Range("a1")
FilledRange.CurrentRegion.Select
Selection.Find(What:="Position Number", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ColNum = ActiveCell.Column
MsgBox (ColNum)
Set Range1 = Range("'C'& ColNum" & "R1")
MsgBox (Range1)
Use Cells:
Set Range1 = Cells(1,Colnum)
One should avoid .Select and .Activate:
Dim FilledRange As Range
Dim Range1 As Range
Dim Rng As Range
Dim findrng As Range
Dim ColNum As Long
With Worksheets("FILLED Today")
Set FilledRange = .Range("A1").CurrentRegion
Set findrng = FilledRange.Find(What:="Position Number", After:=.Range("A1"), LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not findrng Is Nothing Then ' test to ensure it was found.
ColNum = findrng.Column
MsgBox ColNum
Set Range1 = .Cells(1, ColNum)
MsgBox Range1
Else
MsgBox "String not found in Range"
End If
End With
I'm relatively new to the whole Visual Basic scene but do have basic knowledge in programming and I understand how to read code and follow the logic patterns.
What I am trying to accomplish in this macro is the following:
Find the row in the spreadsheet that says the word "Suppressed" then delete that row and the following rows until it finds the row which says "Other Response Categories" in it, and stop there without deleting that from the row.
Find the row in the spreadsheet that says the words "Requires Challenge Response" and delete that row along with all rows underneath it until it finds a row which has a line of text in it named "Tracking Links Clicked" and stop there without deleting that from the row.
Find the row in the spreadsheet that says the words "Link Name (HTML)" and delete that row along with all rows underneath it.
I have used the "Record Macro" function to get a general idea on how to remove lines of text from excel but only by using ranged areas which are selected then deleted; not searching for key phrases.
I'm in the works on researching a lot of VB stuff in order to actually write what I want to accomplish.
Edit2: So I modified and simplified down the VB code that you provided to at least try and get the same response you provided; but only searching for one of the values. I wanted to get correct input for one value before trying to add in more.
Edit 3: Was able to write the script with the assistance of a friend, thank you so much everyone for their input. I have attached the working script on here:
Option Explicit
Sub Autoformat()
Dim WSA As Worksheet
Dim Rng1 As Range
Dim Rng2 As Range
Dim lpRange As Range
Dim sArr As Variant
Set WSA = ActiveSheet
Dim i As Long
sArr = Array("Suppressed", "Other Response Categories", "Requires Challenge Response", "Tracking Links Clicked", "Link Name (HTML)")
Rows("6:9").Delete
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
For i = 0 To 3 Step 2
Set lpRange = WSA.UsedRange
Set Rng1 = lpRange.Find(What:=sArr(i), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
MatchCase:=False)
Set Rng2 = lpRange.Find(What:=sArr(i + 1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
MatchCase:=False)
On Error Resume Next
If Not Rng1 Is Nothing And Not Rng2 Is Nothing And Rng2.Row > Rng1.Row Then
WSA.Rows(Rng1.Row & ":" & Rng2.Row - 1).Delete
ElseIf Not Rng1 Is Nothing And Rng2 Is Nothing Then
WSA.Rows(Rng1.Row).Delete
End If
Next i
Set lpRange = WSA.UsedRange
Set Rng2 = lpRange.Find(What:=sArr(i), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
MatchCase:=False)
If Not Rng2 Is Nothing Then
WSA.Rows(Rng2.Row & ":" & Rows.Count).Clear
End If
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
Sub ClearNames()
Dim n As Name
For Each n In ThisWorkbook.Names
n.Delete
Next n
End Sub
The Macro Recorder is a great way of discovering the syntax of statements you do not know. However, the Macro Recorder does not know your objectives; it just records each of your actions. The result needs a lot of tidying up.
You must learn Excel VBA if you are going to post questions and expect to understand the answers. Search the web for "Excel VBA Tutorial". There are many to choose from so pick one that matches your learning style. I preferred to visit a large library and try out the VB Excel primers they had. I then bought the one I liked.
This is to give you are start at tidying up something created with the Macro Recorder.
I placed your key phrases in random cells down a worksheet and then searched for them in turn. The macro recorder's output was:
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 07/05/2014 by Tony Dallimore
'
Cells.Find(What:="Suppressed", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Cells.Find(What:="Other Response Categories", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Cells.Find(What:="Requires Challenge Response", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Cells.Find(What:="Link Name (HTML)", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
End Sub
This code finds the four phrases but does not do anything else. This shows the syntax of the Find method. We need to tidy this code and save row numbers rather than activate (select) cells. Rather than try to explain each change I have created the code below from the code above. Study the differences and try to understand what I have done and why. Come back with questions if necessary but the more you can achieve on your own, the faster you will build up your skills.
Sub Demo()
Dim Rng As Range
Dim RowSupp As Long
Dim RowOther As Long
Dim RowReq As Long
Dim RowLink As Long
With Worksheets("Sheet1")
Set Rng = .Cells.Find(What:="Suppressed", After:=.Cells(Rows.Count, Columns.Count), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
' Note in the above statement I have replaced "ActiveCell" with ".Cells(Rows.Count, Columns.Count)"
' which is the bottom right cell. Find does not look at the start cell, it wraps and starts
' searching from A1. I have also replaced "xlPart" with "xlWhole".
If Rng Is Nothing Then
Call MsgBox("""Suppressed"" not found", vbOKOnly)
Exit Sub
End If
RowSupp = Rng.Row
Set Rng = .Cells.Find(What:="Other Response Categories", After:=.Cells(Rng.Row, Rng.Column), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Rng Is Nothing Then
Call MsgBox("""Other Response Categories"" not found", vbOKOnly)
Exit Sub
End If
RowOther = Rng.Row
Set Rng = .Cells.Find(What:="Requires Challenge Response", After:=.Cells(Rng.Row, Rng.Column), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Rng Is Nothing Then
Call MsgBox("""Requires Challenge Response"" not found", vbOKOnly)
Exit Sub
End If
RowReq = Rng.Row
Set Rng = .Cells.Find(What:="Link Name (HTML)", After:=.Cells(Rng.Row, Rng.Column), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Rng Is Nothing Then
Call MsgBox("""Requires Challenge Response"" not found", vbOKOnly)
Exit Sub
End If
RowLink = Rng.Row
End With
Debug.Print """Suppressed"" found on row " & RowSupp
Debug.Print """Other Response Categories"" found on row " & RowOther
Debug.Print """Requires Challenge Response"" found on row " & RowReq
Debug.Print """Link Name (HTML)"" found on row " & RowLink
End Sub
The above macro has found the four rows and has proved it has found them by outputting their values to the Immediate Window.
For my dummy worksheet, the output is:
"Suppressed" found on row 6
"Other Response Categories" found on row 11
"Requires Challenge Response" found on row 16
"Link Name (HTML)" found on row 22
If I am unsure what I am doing, I always code this way. I identify step 1 and code a routine to achieve step 1. I then identify step 2 and update my code to achieve that as well.
If my data matched yours, you would want rows 6 to 10 deleted.
You have posted:
Rows("6:9").Select
Selection.Delete Shift:=xlUp
If we tidy that up we first get:
.Rows("6:9").Delete Shift:=xlUp
The next step is to replace the 6 and the 9 with the row numbers that macro Demo discovered:
.Rows(RowSupp & ":" & RowOther - 1).Delete Shift:=xlUp
Place this under RowOther = Rng.Row and run Demo again.
The first lot of rows are deleted.
Step 3 is to consider how to adjust the third Find statement. The current macro relies on RowOther not moving between Finds 2 and 3. But it has moved up by the number of lines deleted. You cannot use .Cells(Rng.Row, Rng.Column) as the start point for Find 3.
I leave you to think about where to start Find 3.
1
2
3
4
.
.
So I have a sequence of numbers running from 1-20. I have the number "1" on top selected and I would like to search the entire column and find the number "9". The code works when I don't name the range "rng"; it finds the number and selects. But the code stops working when I name the range of number. What's wrong with the range function? could it be that if I define Dim rng as Range that when I later define the "Set rng=" I cannot have the ".Select" or ".Copy" extension on the end?
Sub macro2()
Dim rng As Range
Set rng = Range(ActiveCell, ActiveCell.End(xlDown)).Select
rng.Find(10).Select
End Sub
Also, If I want to sum the entire column from 1-20, on the last cell below the number "20" should I use the following code? because the application object doesn't seem to do it. Thank you!
rng.End(xlDown).Offset(1, 0).Select
Application.WorksheetFunction.Sum (rng.Value)
To look for 10 in the active column you could try this (which ends up selecting the first 10 - although Select in vba isn't normally needed other than taken the user to location at code end)
test that the found range exists (ie you can find 10 before proceeding)
you should also use xlWhole to avoid matching 100 if the current default for [lookAt] is xlPart
using search [After] as Cells(1, ActiveCell.Column , and [Search Direction] as xlNext finds the first value looking down.
code
Sub QuickFind()
Dim rng1 As Range
Set rng1 = ActiveCell.EntireColumn.Find(10, Cells(1, ActiveCell.Column), xlFormulas, xlWhole, , xlNext)
If Not rng1 Is Nothing Then
Application.Goto rng1
Else
MsgBox "10 not found"
End If
End Sub
Part 2
Sub Other()
Dim rng1 As Range
Set rng1 = Range(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column).End(xlUp))
rng1.Cells(rng1.Cells.Count).Offset(1, 0) = Application.WorksheetFunction.Sum(rng1.Value)
End Sub
Try this, I hope this will help u to find the specific row no as well as column name too. In code you can use
strRw = FindColumn(Sheet name, "Value which need to be found", True, "Cell Name",Row number)
sourceCOL = colname(FindColumn(Shee Name, "Value which need to be found", False, , 4))
Below is main function of find
Public Function FindColumn(colnocountWS As Worksheet, srcstr As String, Optional rowflag As Boolean, Optional bycol As String, Optional strw As Integer, Optional stcol As Integer) As Integer
Dim srcrng As Range 'range of search text
Dim srcAddr As String 'address of search text
Dim stcolnm As String
colnocountWS.Activate
If stcol <> 0 Then stcolnm = colname(stcol)
If stcol = 0 Then stcolnm = "A"
If strw = 0 Then strw = 1
colnocountWS.Range(stcolnm & strw).Select
If ActiveSheet.Range(stcolnm & strw) = srcstr Then
ActiveSheet.Range(stcolnm & strw).Select
FindColumn = 1
Else
If bycol = "" Then
Set srcrng = colnocountWS.Cells.Find(Trim(srcstr), after:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set srcrng = colnocountWS.Cells.Find(Trim(srcstr), after:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'ByPart
If srcrng Is Nothing Then
If bycol = "" Then
Set srcrng = colnocountWS.Cells.Find(Trim(srcstr), after:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set srcrng = colnocountWS.Cells.Find(Trim(srcstr), after:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
End If
If srcrng Is Nothing Then
FindColumn = 0
Exit Function
Else
srcAddr = srcrng.Address
colnocountWS.Range(srcAddr).Select
FindColumn = ActiveCell.Column
If rowflag = True Then FindColumn = ActiveCell.Row
End If
End If
End Function
'this function find column name
Public Function colname(iFinalCol1 As Integer) As String
Dim colnm As String
On Error GoTo gg
If Mid(Cells(1, iFinalCol1).Address, 3, 1) = "$" Then
colnm = Mid(Cells(1, iFinalCol1).Address, 2, 1)
Else
colnm = Mid(Cells(1, iFinalCol1).Address, 2, 2)
End If
gg: colname = colnm
End Function