Hey there all,

I have the following code which I have patched together from this forum, and various other places. The code all works, but it is ugly as can be. I was wondering if someone could take the time to explain to me how to clean it up and make it work faster. I use this along with a lot of code on the sheets to split out data from a huge data sheet into individual sheets that can then be reviewed and approved by the various people who are involved. It generates between 50 to 100 files per run, so as you can imagine by looking at my code, it is very slow. However, it is way faster than the way it used to be done (1 data entry person all day every day.)

Option Explicit
Sub Convert_and_Rename()
'Removes ALL formulas and replaces them with values,
'for each sheet in your workbook
'Then replaces all tab names with the date in C7

'Values
Application.ScreenUpdating = False
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
sht.UsedRange.Formula = sht.UsedRange.Value
Next sht
Application.CutCopyMode = False
Application.ScreenUpdating = True


'RenameSheets()
    Dim i As Integer, n As Integer, ctr As Integer
    Dim LastIndex As Long, NextIndex As Long
    Dim strNewName As String, strOldName As String
    Dim strRange As String
    
    strRange = "c7"
    For i = 1 To Worksheets.Count
        If Worksheets(i).Range(strRange) <> "" Then
            strNewName = Format(Worksheets(i).Range(strRange), "dd-mmm-yyyy")
        Else
            strNewName = "Default"
        End If
        If InStr(1, Worksheets(i).Name, strNewName) = 0 Then
            For n = 1 To Sheets.Count
                If InStr(1, Worksheets(n).Name, strNewName) Then
                    strOldName = Worksheets(n).Name
                    ctr = ctr + 1
                    If InStr(1, strOldName, "(") Then
                        LastIndex = Mid(strOldName, InStr(1, strOldName, "(") + 1, _
                                        Len(strOldName) - 1 - InStr(1, strOldName, "("))
                        If LastIndex > NextIndex Then NextIndex = LastIndex
                    End If
                End If
            Next
            If NextIndex >= ctr Then ctr = NextIndex + 1
            If ctr > 0 Then strNewName = strNewName & "(" & ctr & ")"
            Worksheets(i).Name = strNewName
            ctr = 0
            NextIndex = 0
         End If
    Range("a1").Select
     ActiveWindow.Zoom = 100
     Next

'Delete Extra sheets
Application.DisplayAlerts = False
For Each sht In Sheets
If sht.Range("c7").Value < 10000 Then sht.Delete
Next
Application.DisplayAlerts = True

'Delete Data sheet
Application.DisplayAlerts = False
For Each sht In Sheets
If sht.Range("a1").Value = "Labor Log Id" Then sht.Delete
Next
Application.DisplayAlerts = True






' createFilesFromSheets()
' Declare variables
Dim ws As Worksheet, mySheet, myPath, myName, myMonth, myDate, myYear, myDir
myPath = ActiveWorkbook.Path
' Loop through the worksheets in the workbook & create new file for each sheet
For Each ws In ActiveWorkbook.Worksheets
' Get the worksheet name...
mySheet = ws.Name
' Make a copy of the worksheet...
ws.Copy Before:=Worksheets(1)
' Move worksheet to a new file...
Worksheets(1).Move
' Name new worksheet as its' parent...
ActiveSheet.Name = mySheet
' Get Employee Name
myName = Range("Employee_")
' Get Date
myDate = Range("Date_")
' Get Month
myMonth = Format(myDate, "mmm")
' Get Year
myYear = Format(myDate, "yyyy")
' Check Directory Path and create if necessary
myDir = myPath & "\" & myYear & "\" & myMonth & "\"
If Dir(myDir, vbDirectory) = vbNullString Then
            MkDir myDir
            End If
' Save as Excel file w/Sheet name and into proper month and year
ActiveWorkbook.SaveAs Filename:=myPath & "\" & myYear & "\" & myMonth & "\" & myName & " " & mySheet & ".xlsx", FileFormat:=51, CreateBackup:=False
' Save as Excel file into temp file for email
ActiveWorkbook.SaveAs Filename:=myPath & "\" & "Temp" & "\" & myName & " " & mySheet & ".xlsx", FileFormat:=51, CreateBackup:=False
' Close the new file...
ActiveWindow.Close SaveChanges:=False
Next ws
End Sub