Renaming Sheets and searching queries

[phimutau]

I would like to rename 228 sheets with the teams listed in cell b2:b229. The sheets already exist and are based off a template.
The template has two cells that are web queries. ("Template" i25 for column D and "Template" ac25 for Column E)
These web queries are listed in columns D and E and are associated with each team.

Can someone help me with renaming these 228 sheets and searching their respective queries? Doing this manually without VBA would take me a month.

Once inside the query I select "disable date recognition" so that my data does not show up as dates. Will this cause problems?

Thanks for your help.

 

[John_w]

See if this macro works for you. Test it on a copy of your workbook.

The macro expects the sheet containing the data shown in your first image to be named "Template" - change ActiveWorkbook.Worksheets("Template") if it has a different name.

As a 'safety catch' the macro has a Yes/No prompt if it finds the sheet to be renamed and only renames the sheet if you click 'Yes'. Delete the If MsgBox ... Then and corresponding End If statements once you've confirmed that the macro is working correctly.

Public Sub Rename_Web_Query_Sheets()

    Dim ws As Worksheet
    Dim qt As QueryTable
    Dim qtArray() As String, n As Long
    Dim r As Long
    Dim foundIndex As Long
    
    'Create array of all web queries for fast searching
    
    n = 0
    For Each ws In ActiveWorkbook.Worksheets
        For Each qt In ws.QueryTables
            n = n + 1
            ReDim Preserve qtArray(1 To 2, 1 To n)
            qtArray(1, n) = qt.Connection
            qtArray(2, n) = qt.Destination.Worksheet.Name
        Next
    Next
    
    With ActiveWorkbook.Worksheets("Template")
    
        For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
        
            'Search array for sheet containing query connection in column D
            
            foundIndex = 0
            n = 1
            While n <= UBound(qtArray, 2) And foundIndex = 0
                If InStr(qtArray(1, n), .Cells(r, "D").Value) Then foundIndex = n
                n = n + 1
            Wend
            
            If foundIndex <> 0 Then
                'Rename found sheet
                If MsgBox(.Name & " sheet row " & r & vbCrLf & "Web query connection " & .Cells(r, "D").Value & " found in sheet " & qtArray(2, foundIndex) & vbCrLf & _
                          "Rename " & qtArray(2, foundIndex) & " as " & .Cells(r, "B").Value & "?", vbInformation + vbYesNo, "Web query found") = vbYes Then
                    ActiveWorkbook.Worksheets(qtArray(2, foundIndex)).Name = .Cells(r, "B").Value
                End If
            Else
                'Sheet not found
                MsgBox .Name & " sheet row " & r & vbCrLf & "Web query connection not found for " & .Cells(r, "D").Value, vbExclamation, "Web query not found"
            End If
        
        Next
        
    End With
    
End Sub

 

[phimutau]

Thank you so much for replying. I tried to run it and this is the message I got along with the corresponding debug highlight. The first sheet with the list of schools and their corresponding web addresses is named "List". The second sheet with red conditional formatting is named "Template". Then there are 228 more sheets named Template (229), Template (228), and so on all the way to Template (2).

I appreciate the help and if there is anything I can do to make this easier please let me know.

 

[John_w]

The error indicates that the code isn't finding any web queries. By web query I mean the 'legacy' web query (which is confirmed by your comment about disabling date recognition), not the new Power Query web query.

Where have you put the code? Is it in the 'main' workbook which contains the "List" sheet and the 229 template sheets, or is it in another workbook? If the code is in another workbook then you must run the macro from the 'main' workbook, i.e. the active workbook.

Since your first image data is in the "List" sheet, change:

    With ActiveWorkbook.Worksheets("Template")

to:

    With ActiveWorkbook.Worksheets("List")

and add this line above it to display the number of web queries found in the active workbook:

    MsgBox "Active workbook = " & ActiveWorkbook.Name & vbCrLf & "Number of web queries = " & n

Run the macro and post the output shown in the message.

 

[phimutau]

I must be doing something wrong. The list in column D and E are just web addresses that I normally manually put in by going to "Data", then to "From Web". I copy and paste that address and then set up my parameters by disabling date recognition and then unchecking the adjust column box once I am back in the excel sheet. I am self taught with all of my excel knowledge and I am still a pretty big novice. I do appreciate your help. I would be willing to send you the file if you wanted, and donate to venmo or paypal for your time.

 

[John_w]

You haven't answered my question and it's still not clear whether you're talking about legacy web queries or Power Query web queries. With the former, Excel displays a mini web browser with yellow arrows showing the HTML tables which can be imported, whereas the latter lets you drill down to the required data and has a 'Transform Data' button. Post some screenshots showing how you create the web query so that we can see which type it is.

No payment can be offered or accepted on this forum.

 

[phimutau]

First step - copy web address into new web query

Second Step - Alt + O-F-D

Third Step - Alt+R

Fourth Step - Alt+A then Enter Enter

My web query is created. I have to do this twice per sheet to get the player ratings and then the player formations.

Does that help? I think this is the legacy method you were speaking of.

 

[John_w]

Yes, that is a legacy web query.

Please answer my question in post 4 (Where have you put the code?), do the code changes and post the MsgBox output.

 

[phimutau]

I don't understand what you mean by code? I have no code that I am aware of. I put the web queries in I25 and AC25 respectively for each rating query and formation query. I bet I am frustrating.

 

[John_w]

I don't understand what you mean by code?

My VBA code (macro) in post 2, which you ran and showed the result of in post 3!

To make it easier for you, use this VBA code macro instead. Paste all this code into a new regular module in the same workbook as your data and save it as a macro-enabled workbook (.xlsm file). See the tutorial here:

How to Add Macro Code to Excel Workbook

How to copy Excel macro VBA code to your workbook, from website or sample file. Different types of code, where to paste it. Step-by-step videos, written steps

www.contextures.com

Option Explicit


Public Sub Rename_Web_Query_Sheets()

    Dim ws As Worksheet
    Dim qt As QueryTable
    Dim qtArray() As String, qtArrayLen As Long
    Dim r As Long, n As Long
    Dim foundIndex As Long
    
    'Create array of all web queries for fast searching
    
    qtArrayLen = 0
    For Each ws In ActiveWorkbook.Worksheets
        For Each qt In ws.QueryTables
            Debug.Print qt.Connection, qt.Destination.Worksheet.Name, qt.Destination.Address
            qtArrayLen = qtArrayLen + 1
            ReDim Preserve qtArray(1 To 2, 1 To qtArrayLen)
            qtArray(1, qtArrayLen) = qt.Connection
            qtArray(2, qtArrayLen) = qt.Destination.Worksheet.Name
        Next
    Next
    
    MsgBox "Active workbook = " & ActiveWorkbook.Name & vbCrLf & "Number of web queries = " & qtArrayLen
    
    Debug.Print "qtArrayLen = " & qtArrayLen
    Debug.Print qtArray(1, 1), qtArray(2, 1)
    Debug.Print qtArray(1, 2), qtArray(2, 2)
    
    With ActiveWorkbook.Worksheets("List")
    
        For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
        
            'Search array for sheet containing query connection in column D
            
            Debug.Print r, .Cells(r, "D").Value
            foundIndex = 0
            n = 1
            While n <= UBound(qtArray, 2) And foundIndex = 0
                Debug.Print n, qtArray(1, n), qtArray(2, n)
                If InStr(qtArray(1, n), .Cells(r, "D").Value) Then foundIndex = n
                n = n + 1
            Wend
            
            If foundIndex <> 0 Then
                'Rename found sheet
                Debug.Print "found " & qtArray(1, foundIndex), qtArray(2, foundIndex)
                If MsgBox(.Name & " sheet row : " & r & vbCrLf & "Web query connection : " & .Cells(r, "D").Value & vbCrLf & "Found in sheet : " & qtArray(2, foundIndex) & vbCrLf & vbCrLf & _
                          "Rename sheet " & qtArray(2, foundIndex) & " as " & .Cells(r, "B").Value & "?", vbInformation + vbYesNo, "Web query found") = vbYes Then
                    ActiveWorkbook.Worksheets(qtArray(2, foundIndex)).Name = .Cells(r, "B").Value
                End If
            Else
                'Sheet not found
                MsgBox .Name & " sheet row : " & r & vbCrLf & "Web query connection not found for " & .Cells(r, "D").Value, vbExclamation, "Web query not found"
            End If
        
        Next
        
    End With
    
End Sub

Run the Rename_Web_Query_Sheets macro and post the MsgBox output.