VBA to find and list all sheets with specific text, and place the sheet names in range to be used as loop

[mouthpear]

VBA to find and list all sheets with specific text, and place the sheet names in range to be used as loop.

I need help to make a few macros please.

The first Macro “FindSheets” is to find and list all the sheet names which have a specific word/text/phrase. Let’s say “BOWCHICAWOWWOW”. Then list them in a table/defined name range “SheetNames1” with the header the text/word to look for. Last place this table into Worksheet “Lists”. Exclude the WS “Lists” from the search. Expanding and reducing the range as needed.

WS ”Lists” Column “O” Row “2 to whatever”

BOWCHICAWOWWOW <<<<< Input word/text into header to search for
Sheet2 <<<<< list with sheet names that have the text
VMS
IMS
Sheet1
FS
Sheet4
Data

The next Macro ”RangeToArray” is to make any range like “SheetNames1” into an Array that can be used in a loop. Macro to be made as a function or sub that can be run from another Macro.Last note.

There will be other ranges to be made like this. Like “SheetNames2”,”Systems”,”Costs” and they each have their own Range and unique search word/phrase. I would like to use Macro “FindSheets” for each of these separately, when the search word is entered.

So when I run Macro ColumnWidths, I can choose a set of column widths, and choose which array to use.

I don’t use VBA often. I have looked for a few days to find a code but all I find are Macros that put the Names into message boxes or you are taken to the Sheet. That is not what I am looking for. Please help. Thank you in advance.

 

[mouthpear]

Is there no one that can help?


Well a week after I posted and had not gotten any replies, I came up with this. I had to tear apart many different macro examples. Now I need help refining them. Specaily with making the range into an array that can be used in a macro loop.

Also, everywhere I had to use Range("SpecificText" & N), and Range("Here" & N) I could not get the Public variant to work, so as not to have to do this.

I would post a file but I don't see an option to do that.

---

This code is placed in "GetSheetsMod" module.

Option Explicit
Public SpecText As Variant
Public N As Variant
Sub GetSheets1()
    SpecText = Range("SpecificText1")
    N = "1"
    GetSheets
End Sub
Sub GetSheets2()
    SpecText = Range("SpecificText2")
    N = "2"
    GetSheets
End Sub
Sub GetSheets3()
    SpecText = Range("SpecificText3")
    N = "3"
    GetSheets
End Sub
Sub GetSheets()
    Application.ScreenUpdating = False
    Dim strSearch As String, strFirstAddress As String
    Dim wOut As Worksheet, wks As Worksheet
    Dim lRow As Long
    Dim rFound As Range, rng As Range
    Dim ColNum As Variant, RowNum As Variant, rngRowCount As Variant
    Dim tbl As ListObject
    
    On Error GoTo ErrHandler
    strSearch = SpecText
    ColNum = Range("SpecificText" & N).Column
    RowNum = Range("SpecificText" & N).Row
    
    Set wOut = Worksheets("Lists")
    lRow = RowNum
    With wOut
    Range("Here" & N).Clear
    
        Do
            rngRowCount = Range("Here" & N).Rows.Count
            Set tbl = Worksheets("Lists").ListObjects("Data" & N)
            On Error Resume Next
            tbl.ListRows(rngRowCount).Delete
        Loop While rngRowCount > 1
    
        For Each wks In Worksheets
            If wks.Name <> "Lists" Then
            Set rFound = wks.UsedRange.Find(strSearch)
            
                If Not rFound Is Nothing Then
                strFirstAddress = rFound.Address
                End If
                
                Do
                    If rFound Is Nothing Then
                        Exit Do
                    Else
                        lRow = lRow + 1
                        .Cells(lRow, ColNum) = wks.Name
                    End If
                'Set rFound = wks.Cells.FindNext(After:=rFound)
                Loop While strFirstAddress <> rFound.Address
            End If
        Next
    .Columns(ColNum).EntireColumn.AutoFit
    .Columns(ColNum - 1).ColumnWidth = 2
    .Columns(ColNum + 1).ColumnWidth = 2
    
    Range("Here" & N).Sort Key1:=Range("Here" & N).Cells(2, 1), _
    Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    End With

ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

---

Now this code is in "RangeToArrayMod" Module

Public Function GetArray(xlRange As Range) As String()
    Dim strArray() As String
    Dim iCounter As Integer
    Dim intCount As Integer
    Dim xlCell As Range
      
    iCounter = 0
    intCount = xlRange.Cells.Count
      
        ReDim strArray(0 To intCount - 1)
        For Each xlCell In xlRange
                strArray(iCounter) = xlCell.Value
                iCounter = iCounter + 1
        Next

    GetArray = strArray
   
End Function