VBA to rename sheets based on cell value (with duplicates)

[Excel_Blonde]

Hi All,

I've seen many posts with questions similar to my own but cant find one to solve my problem.

In fact I have a few issues which I will detail here, any solutions to any of them will be extremely helpful.

I have a report I export into excel, the report is multiple sheets each sheet being an individual record. I want to carry out analysis on this but the way the information is displayed isn't great. I have tried many ways of addressing this but having no luck...

1. So the first issue is I need to rename each sheet with a given cell value...typically (I4), there will be duplicates so need to add incremented suffixes. I say typically because it isn't always I4, so that opens up the next problem to be resolved. I would like to use a macro to look for a given term e.g Name and loop through all columns (Within that row) until a value is found and then move that value to I4 (which I guess needs to happen before the rename sequence).
2. Then I would like to create a new sheet at the beginning of the workbook named 'list' listing all worksheet names.
3. I then within each sheet need to look for the first instance of 'total' and loop through all columns (within that row) returning the first 4 values found within the new list sheet.

e.g
List sheet

Sheet Name	Planned S	Planned R	Actual S	Actual R
Fred	2	5	8	20
Tom	12	5	5	8
Geoff	5	8	9	12

<tbody>
</tbody>

I hope you are still with me, I am relatively new to VBA but have been able to create several useful Macro's, I eventually figure things out with help of forums like this so any help would be appreciated and I'm sure I can fill in the blanks.

 

[Excel_Blonde]

Update:

I have managed to generate the code to add the new sheet named 'list' with a list of all other sheets, I've also managed to rename the sheets where the value is in I4 including duplicates. The main issue now is where the data isn't actually in I4. Is there any way of looking at a range rather than I4? eg G4:K4?

I'm currently using the following:

Sub RenameSheets1()


Dim ws As Worksheet, wscount As Integer, wsname As String, dict
Set dict = CreateObject("scripting.Dictionary")


For Each ws In Sheets
If ws.Name <> "List" Then
If ws.Range("I4") <> "" Then
wsname = Replace(ws.Range("I4"), "/", "")
wscount = IIf(dict.Exists(wsname), dict(wsname) + 1, 1)
dict(wsname) = wscount
If wscount = 1 Then
ws.Name = wsname
Else
If wscount = 2 Then Sheets(wsname).Name = wsname & -1
End If
End If
End If
Next ws
End Sub


Please feel free to advise how I can tidy this up as I've just pieced codes together.