Run macro in all worksheets - excel

Sub MisRec()
Dim ws As Worksheet
For Each ws In Worksheets
Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Select
Range(ActiveCell, "A2").Select
Selection.EntireRow.Delete
Next ws
End Sub
This is the code I have now which is not working fine for me.


You need to be more explicit about where you're searching, and also you should test that something was found before proceeding:
Sub MisRec()
Dim ws As Worksheet, f As Range
For Each ws In Worksheets
Set f = ws.Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:= xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing then
ws.Range(f.Offset(-2, 0), ws.Range("A2")).EntireRow.Delete
End If
Next ws
End Sub

Related

For loop each workbook

I'm trying to loop through every worksheet in my file and if certain word is found in workbook delete that cell with other eleven cells below.
I give up. My code doesn't work. Can't figure out why.
Can someone help me please?
Sub forEachWs()
Dim ws As Worksheet
Dim find As Range
For Each ws In ActiveWorkbook.Worksheets
Sheets(ws).Select
Set find = Cells.find(What:="nieusprawiedliwiona", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not find Is Nothing Then find.Activate
Range(Selection, Selection.Offset(11, 0)).Select
Selection.EntireRow.Delete
Next ws
End Sub

Ok. I got it working.
Sub forEachWs()
Dim ws As Worksheet
Dim find As Range
For Each ws In Worksheets
MsgBox (ws.Name)
ws.Select
Set find = Cells.find(What:="nieusprawiedliwiona", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not find Is Nothing Then find.Activate
Range(Selection, Selection.Offset(11, 0)).Select
Selection.EntireRow.Delete
Next ws
End Sub

Try without the select/activate:
Sub forEachWs()
Dim ws As Worksheet
Dim find As Range
For Each ws In ActiveWorkbook.Worksheets
Set find = ws.Cells.find(What:="nieusprawiedliwiona", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not find Is Nothing Then find.Resize(12,1).EntireRow.Delete
Next ws
End Sub

Excel/vba: How to skip to next sheet if error?

I'm trying to Find "HFM" from every worksheet and if there is one paste some names after that. So the problem is how to avoid adding the names to the sheet when there is no "HFM" in the sheet?
I first had the code without On Error Resume Next but then there is runtime error. When adding that it copies the names to all sheets. Also it returns runtime error if started from sheet that doesn't have "HFM". So how do I fix this?
Dim ws As Worksheet
For Each ws In Worksheets
Cells.Find(What:="HFM", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
On Error Resume Next
ActiveCell.Offset(0, 3).Select
ActiveCell.FormulaR1C1 = "name1"
' etc.

Instead of On Error Resume Next you will have to declare a variable proceed based on result. An Example below.
Dim ws As Worksheet
For Each ws In Worksheets
' Search for a text
Set MyObjectvie = ws.Cells.Find(What:="HFM", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not MyObjectvie Is Nothing Then
' if the text is found do the task
MyObjectvie.Offset(0, 3).Value = "name1"
End If
Next ws

ActiveCell Based Selection

Column A to H has data with some blanks in between. I want to find "ABC" in column A and then select 2 rows above - this will be my ActiveCell.
I want to delete rows in between ActiveCell to Row2 (Active Cell is Dynamic)
Sub format()
Cells.Find(What:="abc", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:= xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Select
Range(Selection, ActiveCell, A2).Select
End Sub

The code will do the job for you:
Sub format()
Dim rng As Range
Set rng = Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Offset(-2, 0).Select
Range(Cells(Selection.Row, 1), Cells(2, 1)).Select
'Selection.EntireRow.Delete
End Sub
Currently I have commented out the last line which will delete the Rows you want. uncomment it, but first be sure that's what you want to delete.

For Range please try:
(ActiveCell, "A2").Select

Excel VBA-Find string in sheet2 and copy the this in sheet1

i look for a Code in VBA to look after Strings (called "Setup") in sheet2 and copy the String under "Setup" into sheet1 in cell A1.
I have a not working code from a recorded macro:
Sub FindString()
Cells.Find(What:="Setup", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("I8").Select
Selection.Copy
Sheets("Tabelle1").Select
ActiveSheet.Paste
End Sub
If i change that String, it Shows me error 91...

Try this
Sub FindString()
Sheets("Sheet2").Activate
Cells.Find(What:="Setup", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
'--------------------------------------------------------------------------------------
' Specify the string to find in sheet1 B1 cell
Sub FindString2()
Sheets("Sheet2").Activate
Cells.Find(What:=Sheets("Sheet1").Range("B1").Value, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
End Sub

Similar to #Punith's answer, except you don't need to change sheets.
Option Explicit
Sub find_string()
Const strLookup As String = "Setup"
Dim wb As Workbook, find_ws As Worksheet, to_ws As Worksheet, rngFound As Range
Set wb = ThisWorkbook
Set find_ws = wb.Sheets("find")
Set to_ws = wb.Sheets("to")
Set rngFound = find_ws.Cells.Find(What:=strLookup, LookIn:=xlValues, LookAt:=xlWhole).Offset(1, 0)
to_ws.Range("A1").Value = rngFound.Value
End Sub

Selecting the second result of a "Find" with VBA

I am trying to make it so that I can find the second result for "lights", in case of having various occurrences for this term. The code below finds the first occurrence in the range under consideration.
Dim ws As Worksheet
Dim rng1 As Range
Dim y As Range
Columns("B:B").Select
Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Select
Set x = Range(Selection, Selection.End(xlDown)).Offset(0, 3)
Range(x.Address(0, 0)).Select
Selection.Find(What:="Lights", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Selection.FindNext(After:=ActiveCell).Activate
Selection.FindNext(After:=ActiveCell).Select

FindNext delivers what you want. Using it is easy: perform the first search as you are doing it right now (although by assigning the result to a Range) and take the resulting range as starting point for FindNext. Here you have a sample code adapted to your specific requirements (secondAddress is the Address of the second occurrence of "Light", if any):
Dim foundRange As Range
Dim rangeToSearch As Range
Set rangeToSearch = Selection
Set foundRange = rangeToSearch.Find(What:="Lights", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False) 'First Occurrence
Dim secondAddress As String
If (Not foundRange Is Nothing) Then
foundRange.Activate
Dim count As Integer: count = 0
Dim targetOccurrence As Integer: targetOccurrence = 2
Dim found As Boolean
Do While Not found
Set foundRange = rangeToSearch.FindNext(foundRange)
If Not foundRange Is Nothing Then
count = count + 1
If (count >= targetOccurrence - 1) Then
secondAddress = foundRange.Address
Exit Do
End If
Else
Exit Do
End If
Loop
End If

I found an even easier way as it sounds like I had a similar problem.
If you simplified your search function:
Cells.Find(What:="xxxx", After:=Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
Then add another line beneath:
Cells.Find(What:="xxxx", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select
All this does is find the first occurrence of "xxxx", then the second code finds "xxxx", but begins searching from the result of the first find code (which was the ActiveCell).

Resources