Need Help Creating a Macro

[rsrasc]

Hi all,

I have a macro that will open 26 different workbooks.

All the tabs in all the workbooks are named "Page 1", "Page 2", and so on. In some cases goes to Page 40, in other cases goes to Page 34. It varies.


When i open all the workbooks, the active page in most cased is "Page 1", and it depends on who was using the file before.


I would like to know if someone can help me with a macro that will activate a specific page in all the 26 workbooks if any of the pages has the word or name: "DAVID DAVE".


In some cases, this name will appear in Page 24, in other cases will be showing in Page 21, in other cases in Page 23.


I don't mind going through all the open workbooks to find the specific name I mentioned above but if someone can help me with this task/macro that will be really helpful.

I'll be glad to answer any question if needed.

Regards

[Paul_Hossler]

Hi all,

I have a macro that will open 26 different workbooks.



What does the macro look like?

Are the 26 WB's in one folder?

[rsrasc]

Hi Paul,

Here is the macro that I'm using to open the 26 files, and yes they are all located in one folder.



Sub Open_Payroll_Files_FY20()






Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\1. SSE-PayFile-GBY--PPE 2019-10-07.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\2. SSE-PayFile-GBY--PPE 2019-10-23.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\3. SSE-PayFile-GBY--PPE 2019-11-06.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\4. SSE-PayFile-GBY--PPE 2019-11-20.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\5. SSE-PayFile-GBY--PPE 2019-12-04.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\6. SSE-PayFile-GBY--PPE 2019-12-18.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\7. SSE-PayFile-GBY--PPE 2020-01-01.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\8. SSE-PayFile-GBY--PPE 2020-01-15.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\9. SSE-PayFile-GBY--PPE 2020-01-29.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\10. SSE-PayFile-GBY--PPE 2020-02-12.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\11. SSE-PayFile-GBY--PPE 2020-02-26.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\12. SSE-PayFile-GBY--PPE 2020-03-11.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\13. SSE-PayFile-GBY--PPE 2020-03-25.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\14. SSE-PayFile-GBY--PPE 2020-04-08.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\15. SSE-PayFile-GBY--PPE 2020-04-22.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\16. SSE-PayFile-GBY--PPE 2020-05-06.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\17. SSE-PayFile-GBY--PPE 2020-05-20.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\18. SSE-PayFile-GBY--PPE 2020-06-03.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\19. SSE-PayFile-GBY--PPE 2020-06-17.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\20. SSE-PayFile-GBY--PPE 2020-07-01.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\21. SSE-PayFile-GBY--PPE 2020-07-15.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\22. SSE-PayFile-GBY--PPE 2020-07-29.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\23. SSE-PayFile-GBY--PPE 2020-08-12.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\24. SSE-PayFile-GBY--PPE 2020-08-26.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\25. SSE-PayFile-GBY--PPE 2020-09-09.xlsx"), UpdateLinks:=0
Workbooks.Open ("Z:\FY20 Budget\FinancialManagementGroup\Other Information\Pay Reports\Pay Files\26. SSE-PayFile-GBY--PPE 2020-09-23.xlsx"), UpdateLinks:=0








End Sub

[rsrasc]

Also, I'm using the following code to activate the page where the name of the person is located. Certainly, not the best way to do it since I'm searching for the name by browsing over the different pages, and annotating the page number but it is working. Since I'm doing this for a five-year period, at least I can always go back and open it again if needed.



Sub Code_To_Activate_Page()






Workbooks("1. SSE-PayFile-GBY--PPE 2019-10-07.xlsx").Worksheets("Page 21").Activate
Workbooks("2. SSE-PayFile-GBY--PPE 2019-10-23.xlsx").Worksheets("Page 24").Activate
Workbooks("3. SSE-PayFile-GBY--PPE 2019-11-06.xlsx").Worksheets("Page 24").Activate
Workbooks("4. SSE-PayFile-GBY--PPE 2019-11-20.xlsx").Worksheets("Page 24").Activate
Workbooks("5. SSE-PayFile-GBY--PPE 2019-12-04.xlsx").Worksheets("Page 24").Activate
Workbooks("6. SSE-PayFile-GBY--PPE 2019-12-18.xlsx").Worksheets("Page 24").Activate
Workbooks("7. SSE-PayFile-GBY--PPE 2020-01-01.xlsx").Worksheets("Page 24").Activate
Workbooks("8. SSE-PayFile-GBY--PPE 2020-01-15.xlsx").Worksheets("Page 23").Activate
Workbooks("9. SSE-PayFile-GBY--PPE 2020-01-29.xlsx").Worksheets("Page 23").Activate
Workbooks("10. SSE-PayFile-GBY--PPE 2020-02-12.xlsx").Worksheets("Page 23").Activate
Workbooks("11. SSE-PayFile-GBY--PPE 2020-02-26.xlsx").Worksheets("Page 23").Activate
Workbooks("12. SSE-PayFile-GBY--PPE 2020-03-11.xlsx").Worksheets("Page 23").Activate
Workbooks("13. SSE-PayFile-GBY--PPE 2020-03-25.xlsx").Worksheets("Page 23").Activate
Workbooks("14. SSE-PayFile-GBY--PPE 2020-04-08.xlsx").Worksheets("Page 23").Activate
Workbooks("15. SSE-PayFile-GBY--PPE 2020-04-22.xlsx").Worksheets("Page 23").Activate
Workbooks("16. SSE-PayFile-GBY--PPE 2020-05-06.xlsx").Worksheets("Page 23").Activate
Workbooks("17. SSE-PayFile-GBY--PPE 2020-05-20.xlsx").Worksheets("Page 22").Activate
Workbooks("18. SSE-PayFile-GBY--PPE 2020-06-03.xlsx").Worksheets("Page 22").Activate
Workbooks("19. SSE-PayFile-GBY--PPE 2020-06-17.xlsx").Worksheets("Page 22").Activate
Workbooks("20. SSE-PayFile-GBY--PPE 2020-07-01.xlsx").Worksheets("Page 22").Activate
Workbooks("21. SSE-PayFile-GBY--PPE 2020-07-15.xlsx").Worksheets("Page 22").Activate
Workbooks("22. SSE-PayFile-GBY--PPE 2020-07-29.xlsx").Worksheets("Page 22").Activate
Workbooks("23. SSE-PayFile-GBY--PPE 2020-08-12.xlsx").Worksheets("Page 22").Activate
Workbooks("24. SSE-PayFile-GBY--PPE 2020-08-26.xlsx").Worksheets("Page 22").Activate
Workbooks("25. SSE-PayFile-GBY--PPE 2020-09-09.xlsx").Worksheets("Page 21").Activate
Workbooks("26. SSE-PayFile-GBY--PPE 2020-09-23.xlsx").Worksheets("Page 21").Activate


End Sub

[SamT]

This will only find the first instance of the name in any workbook.
It would be much faster if the name always was in the same cell on any worksheet.


Option Explicit

Sub Code_To_Activate_Page(FindWho As String)
Dim WB As Workbook, Ws As Worksheet
Dim Found As Range

For Each WB In Workbooks
If WB Is ThisWorkbook Then GoTo NextWorkbook
For Each Ws In WB.Sheets
Set Found = Ws.Cells.Find(FindWho)
If Not Found Is Nothing Then
Ws.Activate
GoTo NextWorkbook
End If
Next 'Ws
NextWorkbook:
Next 'WB

ThisWorkbook.Activate
End Sub

Sub Test_CodeToActivatePage()
Code_To_Activate_Page "DAVID DAVE" 'Note Space after Sub Call.
End Sub

[rsrasc]

Hi SamT, thank you for the code. I tested and is working great. Save a lot of time.

I was thinking if it will possible to create in addition to your macro, the possibility of generating a report with the page number where the name was found.

That way (if possible) I can work with other names.

Thank you for your support and cooperation.

Much appreciated.

[SamT]

Something like ? Not tested

Sub Code_To_Activate_Page(FindWho As String)
Dim WB As Workbook, Ws As Worksheet
Dim Found As Range

'Add Report sheet Section
Dim RS As Worksheet 'Report Sheet. 1 per Name
Set RS = ThisWorkbook.Sheets Add
RS.Name = FindWho
With RS.Range("A1:B1")
.Cells(1) = "WorkBook"
.Cells(2) = "WorkSheet"
.Font = Bold
End With '
'End Add Section

For Each WB In Workbooks
If WB Is ThisWorkbook Then GoTo NextWorkbook
For Each Ws In WB.Sheets

Set Found = Ws.Cells.Find(FindWho)
If Not Found Is Nothing Then

'Add Report sheet Section
RS.cells(Rows.Count, "A").End(xlUp.Offset(1) = WB.Name '<<--------------
RS.cells(Rows.Count, "A").End(xlUp.Offset(, 1) = Ws.Name '<<--------------
'End Add Section
Ws.Activate
GoTo NextWorkbook
End If

'Add Report sheet Section
Rs.cells(Rows.Count, "A").End(xlUp.Offset(1) = WB.Name '<<--------------
Rs.cells(Rows.Count, "A").End(xlUp.Offset(, 1) = FindWHo & " Not Found." '<<--------------
'End Add Section

Next 'Ws
NextWorkbook:
Next 'WB

ThisWorkbook.Activate
End Sub

Study the Attachment. I bet you can modify it to help you with your work

[rsrasc]

Hi SamT, first, thank you for the code. Now that I have some time I would like to mention that I downloaded the attachment "Auto Follow Table of Contents.xls" but it only has a sheet with the name TOC where you said study the attachment but there is no information in there.


Since I find your code interesting, and I would like to use it more consistently, I'm attaching a sample file so maybe if you have some time you could explain to me some of the meaning from your code, for example, "WB.Name" "Ws.Name" and others.


When I copied your code the following lines were in red (probably it needs some changes):




Set RS = ThisWorkbook.Sheets Add


RS.cells(Rows.Count, "A").End(xlUp.Offset(1) = WB.Name '<<--------------
RS.cells(Rows.Count, "A").End(xlUp.Offset(, 1) = Ws.Name '<<--------------


Rs.cells(Rows.Count, "A").End(xlUp.Offset(1) = WB.Name '<<--------------
Rs.cells(Rows.Count, "A").End(xlUp.Offset(, 1) = FindWHo & " Not Found." '<<--------------



I did a couple of changes and this is how the coding looks like (of course, it doesn't work)




Sub Code_To_Activate_Page(FindWho As String)
Dim WB As Workbook, Ws As Worksheet
Dim Found As Range


'Add Report sheet Section
Dim RS As Worksheet 'Report Sheet. 1 per Name
Set RS = ThisWorkbook.Worksheets.Add
RS.Name = FindWho
With RS.Range("A1:B1")
.Cells(1) = "Auto Follow Table of Contents"
.Cells(2) = "TOC"
.Font = Bold
End With '
'End Add Section


For Each WB In Workbooks
If WB Is ThisWorkbook Then GoTo NextWorkbook
For Each Ws In WB.Sheets

Set Found = Ws.Cells.Find(FindWho)
If Not Found Is Nothing Then


'Add Report sheet Section
'RS.cells(Rows.Count, "A").End(xlUp.Offset(1) = WB.Name '<<--------------
RS.Cells(Rows.Count, "A").End (xlUp.Offset(1) = "Auto Follow Table of Contents") ''<<--------------


'RS.cells(Rows.Count, "A").End(xlUp.Offset(, 1) = Ws.Name '<<--------------
RS.Cells(Rows.Count, "A").End (xlUp.Offset(, 1) = "TOC") '<<--------------




'End Add Section
Ws.Activate
GoTo NextWorkbook
End If


'Add Report sheet Section
'Rs.cells(Rows.Count, "A").End(xlUp.Offset(1) = WB.Name '<<--------------
'Rs.cells(Rows.Count, "A").End(xlUp.Offset(, 1) = FindWHo & " Not Found." '<<--------------




RS.Cells(Rows.Count, "A").End (xlUp.Offset(1) = "Auto Follow Table of Contents") '<<--------------
RS.Cells(Rows.Count, "A").End (xlUp.Offset(, 1) = FindWho & " Not Found")




'End Add Section


Next 'Ws
NextWorkbook:
Next 'WB


ThisWorkbook.Activate
End Sub




I do a lot of search for coding and when I find something that will help me achieve what I need then I use it but honestly my level of expertise is at the basic level in comparison to all the people providing coding to help us in the process. It's a challenge and a learning experience! Much appreciated!

Cheers!

[SamT]

Set RS = ThisWorkbook.Sheets Add:= shorthand for

Dim RS As Worksheet
Worksheets.Add After:=Sheets(Sheets.Count)
Set RS = Sheets(Sheets.Count)


The sheet in my attachment has VBA code. You can study its Code to learn how to modify your Report sheet or just copy the TOC sheet into your workbook. What it does is list every sheet the workbook it's in, except for itself. Then when you click a sheet name on the list, it opens that sheet and moves itself next to the just opened sheet.

It's a bit of work to write Code that would be inserted into each Report sheet to make it work like TOC. I would create a hidden TOC sheet to work with Workbooks and copy it and rename the copy to FindWho, for each Report. I suggest getting the rest of the code working properly before starting on that request. It should also be a different thread here at VBAX


The best way to see what Code_To_Activate_Page is doing is make sure a sheet has the words "John Smith" somewhere, then place the mouse cursor inside

Sub Test
Code_To_Activate_Page "John Smith"
End Sub
And press F8. Look at Excel each time you press F8 in the VBA Editor after the line RS.Name =FindWho is yellow. Note the yellow line of code is the line that will Run when you press F8

[rsrasc]

Hi SamT, thank you for getting back to me. One observation, the excel extension in your attachment is .xls.

I don't think is the extension for a macro file. I think should be .xlsx. Thoughts?

[SamT]

xls, xlsb, and xlsm files can contain Code
Office versions >=2007 can open xls files. Then Save As an xlsb or xlsm file to preserve the code.
YMMV with Office 365.

[rsrasc]

interesting, I didn't know that. Will look into it. Thanks! Much appreciated.