Home Extract values from "n" sheet by looping all worksheets

# Extract values from "n" sheet by looping all worksheets

Rafael Martínez
1#
Rafael Martínez Published in 2018-01-12 18:25:25Z
 I have a workbook with hundreds of different sheets. I want to loop through each worksheet that contains a specified string and once the sheet is selected, allow me to select two different cells and store them as variables. My code looks for the string by finding the first instance of 57001, replacing it to asdfghjklzxcvbnm (because otherwise it would loop forever using the same instance) until there are no more matches of 57001 (I turn back the modified values to the original ones at the end). Every time the specified string is found, I select the sheet so I can decide whether to store a range as a1 (and afterwards another range as a2) or go to the next match. The loop ends when a2 gets a range. Here's what I've tried: Sub Macro1() On Error Resume Next Dim Loc As Range Dim a1 As Range Dim a2 As Range Dim sht As Worksheet shtIndx = ActiveSheet.Index rplc = "asdfghjklzxcvbnm" rng1 = "57001" For i = ActiveSheet.Index + 1 To Sheets.Count With ThisWorkbook.Worksheets(i) Set Loc = .Cells.Find(What:=rng1) a1 = None If Not Loc Is Nothing Or Not a2 Is Not None Then Do Until Loc Is Nothing .Select .Cells(Loc.Row, Loc.Column).Select Loc.Value = rplc If a1 Is None Then Set a1 = Application.InputBox("First Value?", "Obtain Range Object", Type:=8) Set Loc = .UsedRange.FindNext(Loc) Else Set a2 = Application.InputBox("Second Value?", "Obtain Range Object", Type:=8) End If Loop End If End With Next i For Each sht In ActiveWorkbook.Worksheets sht.Cells.Replace What:=rplc, Replacement:=rng1, _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Next sht Sheets(shtIndx).Select End Sub  My code keeps on looping asking me to fill the first inputbox even though I already selected a cell. Help?
sancho.s
2#
 With this modification the never ending loop is removed. I still do not know if this accomplishes what you mean to, the logic is somewhat obscure. Option Explicit Sub Macro1() On Error Resume Next Dim Loc As Range Dim a1 As Range Dim a2 As Range Dim sht As Worksheet Dim shtIndx As Integer, rplc As String, rng1 As String, i As Integer shtIndx = ActiveSheet.Index rplc = "asdfghjklzxcvbnm" rng1 = "57001" For i = ActiveSheet.Index + 1 To Sheets.Count With ThisWorkbook.Worksheets(i) Set Loc = .Cells.Find(What:=rng1) Set a1 = Nothing If Not (Loc Is Nothing) Or Not (a2 Is Nothing) Then MsgBox "Found string in WS " & .Name Do Until Loc Is Nothing '.Select ' Not really needed '.Cells(Loc.Row, Loc.Column).Select ' Not really needed Loc.Value = rplc If a1 Is Nothing Then Set a1 = Application.InputBox("First Value?", "Obtain Range Object", Type:=8) Set Loc = .UsedRange.FindNext(Loc) Else Set a2 = Application.InputBox("Second Value?", "Obtain Range Object", Type:=8) End If Loop End If End With Next i For Each sht In ActiveWorkbook.Worksheets sht.Cells.Replace What:=rplc, Replacement:=rng1, _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Next sht Sheets(shtIndx).Select End Sub