Home Extract values from "n" sheet by looping all worksheets
Reply: 1

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#
sancho.s Reply to 2018-01-12 20:32:28Z

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
You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.302334 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO