For Each Ws / Renaming tabs mystery

[bestart]

Hello gang,

I am fairly good in MS excel, but relatively new to VBA. I use lots of the tricks and tips of this forum. Thanks.

In my office we distributed a template with several tabs and lots of formulas for individuals to fill in and return. After a couple of weeks of using this template we realized it had some formulas erros. We are talking about 100+, so rather than asking the individuals to retype the info into the new template we decided to created a new template (all errors fix) and populate it thru vba. So, now we are trying to transfer only relevant data (no formulas) into the new template.

First we needed to ensure all the tabs in the old file are named according to a predetermine sequence. So we are using a cell.value to determine what sequence (or name) should the tab be before copying the information into the new template.

Here is the code, I thought it is pretty straight forward but in the " For Each " section of the code for reasons beyond my comprehension when is time to rename the tabs, we are only renaming the same tab. the code does not toggle thru the sheets.

Sub Testing()
    
Dim File01Name As String, File02Name As String, Sht As Worksheet
Dim SitPos As String, SitId As String, SiteNo As Variant

    File01Name = ActiveWorkbook.Name    'Setting up Variable with Active Workbook value
    File02Name = "TestingSendingKeys.xls"
         
    Windows(File01Name).Activate
    
    'Array to determine sheet sequence
    SiteNo = Sheets("Sheet1").Range("B4", Range("b" & Rows.Count).End(xlUp)).Value
    
    'Activate Workbook where all the changes will take effect
    Windows(File02Name).Activate

    For Each Sht In ActiveWorkbook.Worksheets
   
    If Len(Sht.Range("A5")) < 14 Then GoTo finishing
    
    'Msg to determine what sheet met the criteria
    
        MsgBox Sht.Name
        
    'Extracting variable to be used in the match
    SitId = Mid(Sht.Range("A5"), 14, 6)
           
    'Match function to determine the position of the variable SitId in the Array SiteNo
    SitPos = Application.Match(SitId, SiteNo, 0)
            
        MsgBox SitId & ", : " & SitPos
    ' Here  is my problem:
    ' The sheet containing the SitId info should be renamed Depending of the SitPos value.
    ' Only the first sheet is changing. The procedure is not physically toggleing thru the sheets.
    
            If SitPos = 2 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 3 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 4 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 5 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 6 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 7 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 8 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 9 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 10 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 11 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 12 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 13 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 14 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 15 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 16 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 17 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 18 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            If SitPos = 19 Then ActiveSheet.Name = "Sheet " & SitPos - 1
            
finishing:

Next Sht

End Sub

Any help will be appreciated.

[TMS]

Please post a sample workbook.


Regards, TMS

[bestart]

Encountered some issues with the upload. Had to do major reduction on the file.

Let me know if this works.

[TMS]

OK, thanks for this. Unfortunately, it doesn't have a Sheet1 in it and consequently, it can't load the array. If I add a Sheet1 and create a list of worksheets, it will loop through the sheets and pick SITE 1 to process.

It then picks out QATQ as the SitId but, when it tries to match SitId against the SiteNo array, it fails ... because the SiteNo array is a list of worksheets, and QATQ isn't in it.

Note that this code:

    If SitPos = 2 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 3 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 4 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 5 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 6 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 7 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 8 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 9 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 10 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 11 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 12 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 13 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 14 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 15 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 16 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 17 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 18 Then ActiveSheet.Name = "Sheet " & SitPos - 1
    If SitPos = 19 Then ActiveSheet.Name = "Sheet " & SitPos - 1

could be reduced to this:

    If SitPos >= 2 _
    And SitPos <= 19 _
    Then _
        ActiveSheet.Name = "Sheet " & SitPos - 1

or:

    If SitPos >= 2 And SitPos <= 19 Then ActiveSheet.Name = "Sheet " & SitPos - 1

And that actually highlights the crux of your problem (wood for trees issue) ... you don't actually select the sheets so they don't become the Active Sheet.

it needs to be:

    If SitPos >= 2 And SitPos <= 19 Then Sht.Name = "Sheet " & SitPos - 1

So, maybe this will help you to solve your problem after all.


Regards, TMS

[AB33]

Trevor,
On the top of your corrections, there is no error trapping on the match function.

   SitPos = Application.Match(SitId, SiteNo, 0)

I personally do not like the match function, rather prefer to use find and match instead.

[TMS]

@AB33: I quite like the Match function but I would have error trapping around it and test the return value.

In this case it should be a benefit because the code should crash if the value isn't in the list. I'm guessing the example isn't truly representative of the live workbook and maybe Site 1 and Site 2 have the same value as the cell content. Who knows?

Thanks for the input though.

Cheers, TMS

[bestart]

TMS my apologies on the sample workbook... I was so focused on sending a sample that I may have inadvertently stripped a critical part of the spreadsheet. However, your analysis of the problem was on target and the solution clear and effective. Thanks.

On the error trapping issue, any suggestions?

[TMS]

On the error trapping issue, any suggestions?

I would do something like this:

    'Match function to determine the position of the variable SitId in the Array SiteNo
    SitPos = 0                     ' initialise the variable to zero (just in case)
    On Error Resume Next           ' start error trapping
    SitPos = Application.Match(SitId, SiteNo, 0)
    On Error Goto 0                ' stop error trapping
    ' If SitPos is still zero, it did not find a match in the array
    If SitPos = 0 Then Goto lblNoMatch       ' go do something about the error ...

Regards, TMS



If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save


You may also want to consider thanking those people who helped you by clicking on the little star at the bottom left of their reply to your question.

[bestart]

@TMShucks and @AB33
Thanks!!!!!

[TMS]

You're welcome. Thanks for the rep.