[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 268
  • Last Modified:

Find specific word in cell A1 in worksheets

I have a workbook with several worksheets which when saved down are saved with different names each time. [please don't ask why :-)]

I need to find the word Summary which is in cell A1 in one of the worksheet and then rename the worksheet to Summary

Could an expert provide me with the VBA code to do this please.

Thanks
0
Jagwarman
Asked:
Jagwarman
  • 6
  • 3
1 Solution
 
gowflowCommented:
YES TRY THIS

Dim WS as Worksheet

For each WS in Activeworkbook.worksheets
      if WS.Range("A1") = "Summary" then
            if WS.name <> "Summary" then WS.Name = "Summary"
            Exit For
      end if
Next WS

Open in new window


gowflow
0
 
gowflowCommented:
Alternatively, if your Cell A1 maybe contain the word Summary like Summary 2012 Figures then the following code is more appropriate.

Dim WS as Worksheet

For each WS in Activeworkbook.worksheets
      if instr(1,lcase(WS.Range("A1")),"summary") <>0 then
            if WS.name <> "Summary" then WS.Name = "Summary"
            Exit For
      end if
Next WS

Open in new window


gowflow
0
 
JagwarmanAuthor Commented:
Hi gowflow that works a treat. Just in case [because these things keep coming back and biting me on the nose] is it possible to change it from A1 to a Range say A1:K10

Thanks
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
gowflowCommented:
Here it is

Sub FindSummary()
Dim WS As Worksheet
Dim cCell As Range

For Each WS In ActiveWorkbook.Worksheets
    For Each cCell In WS.Range("A1:K10")
        If InStr(1, LCase(cCell), "summary") <> 0 Then
              If WS.Name <> "Summary" Then WS.Name = "Summary"
              Exit For
        End If
    End If
Next WS

End Sub

Open in new window



gowflow
0
 
gowflowCommented:
You have to be very careful on this as if the word summary comes in this range in several worksheets then it is the first occurrence of this word that the macro will rename the sheet.

Now if by chance this sheet already exist then we need to treat this differently.
gowlfow
0
 
JagwarmanAuthor Commented:
Hi gowflow,

that throws up an error End if without block if but I can't figure where the if needs to go

Also, I am happy that it stops at the first so, as you say, what if the sheet summary already exists??

tks
0
 
gowflowCommented:
Yes sorry my mistake instead of putting Next cCell I put End if !!! :(

This code is more stable as it take into consideration the possibility of sheet summary already being there so it will not fall in the trap of renaming an other sheet that contains the word summary. and if it find the first occurrence of summary in the range (A1 to K10) then it will rename the sheet to summary and let you know.

Try it all possible ways.

Sub FindSummary()
Dim WS As Worksheet
Dim cCell As Range
Dim TmpShtName As String

For Each WS In ActiveWorkbook.Worksheets
    For Each cCell In WS.Range("A1:K10")
        If InStr(1, LCase(cCell), "summary") <> 0 Then
            If WS.Name <> "Summary" Then
                On Error Resume Next
                TmpShtName = WS.Name
                WS.Name = "Summary"
                If Err <> 0 Then
                    WS.Name = TmpShtName
                    MsgBox "Sheet Summary already Exist, cannot rename sheet: " & TmpShtName & " to 'Summary'", vbCritical
                Else
                    MsgBox "Sheet: " & TmpShtName & " was renamed to " & WS.Name & " Successfully", vbInformation
                End If
                On Error GoTo 0
                Exit For
            End If
        End If
    Next cCell
Next WS

End Sub

Open in new window


gowflow
0
 
JagwarmanAuthor Commented:
That's brilliant thanks for all the work you put into this for me
0
 
gowflowCommented:
Your welcome my pleasure !
feel free to put a link in here for any question you may need help with.

Rgds/gowflow
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now