Unassigned

[LeeJames]

Hi Guys

I have several workbooks that have multiple worksheets from 80 to 3000 tabs trying to workout an easy way of searching for the word 'unassigned' on each sheet and changing the tab colour, if found. Is that possible?

 

[jmacleary]

Hi there. This is some code I cobbled together a while ago to search every worksheet for a defined text. It first asks which workbook to search, then searches all tabs in that workbook, stopping at the first occurrence. You should be able to modify it for your purposes. Hope it helps.

Dim NameCount As LongDim NameList(30) As String
Dim MsgList As String
      Sub WorksheetLoop()


         Dim WS_Count As Integer
         Dim i As Integer
    Dim found1 As Range
    Dim ErrorFlag As Boolean
    Dim VisibleSet As Boolean
Dim FindVal As String
         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         Call books
 booktodo = InputBox("Please choose the number of the book to search" + vbLf + MsgList)
 With Workbooks(NameList(booktodo))
         WS_Count = .Worksheets.Count
FindVal = InputBox("Please enter what to find")
         ' Begin the loop.
         For i = 1 To WS_Count
.Worksheets(i).Activate
VisibleSet = .Worksheets(i).Visible
.Worksheets(i).Visible = True
'MsgBox ActiveWorkbook.Worksheets(I).Name
            ErrorFlag = False
            On Error GoTo nextbook
     .Worksheets(i).Cells.Find(What:=FindVal, LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
     If ErrorFlag = False Then
     keepon = MsgBox("Match found in " + .Worksheets(i).Name + vbNewLine + vbNewLine + "Do you want to keep looking?", vbYesNo)
     If keepon = vbNo Then
     
     Exit Sub
     End If
     End If
.Worksheets(i).Visible = VisibleSet
         Next i
     End With
     GoTo ender
nextbook:
On Error GoTo 0
ErrorFlag = True
Resume Next
ender:
If ErrorFlag = True Then
MsgBox "Not found in any worksheet"
End If
      End Sub


Sub books()
Dim i As Long, msg As String
MsgList = ""
Erase NameList
For i = 1 To Workbooks.Count
    NameList(i) = Workbooks(i).Name
    MsgList = MsgList & Format(i) & " " & Workbooks(i).Name & vbLf
Next
NameCount = Workbooks.Count
End Sub

 

[Fluff]

Another option

Sub searchFind()
   Dim Wbk As Workbook
   Dim Ws As Worksheet
   Dim Fname As String
   Dim Fnd As Range
   
   Fname = Application.GetOpenFilename()
   If Fname = "" Then Exit Sub
   Set Wbk = Workbooks.Open(Fname)
   For Each Ws In Wbk.Worksheets
      Set Fnd = Ws.UsedRange.Find("unassigned", , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then Ws.Tab.Color = 45678
   Next Ws
End Sub

 

[LeeJames]

That's great! Thank you both

 

[Fluff]

Glad we could help & thanks for the feedback