Replacing Lists and macros with different names

[bishop7262]

I have worksheets, ie "Sarah", "Dave", "Joe", etc. Now I have some Macros and Lists created with these names:

Example:
Macros:
Data_Sarah
Home_Sarah

Lists:
List1_Sarah
List2_Sarah
MonthNames_Sarah
MonthTable_Sarah

Now when Sarah is no longer with us I have to replace her and rename her Worksheet to another employee. So when I rename the worksheet to, "Mike" all the Macros and Lists still has "Sarah". Is there any way that a macro can be made to change the Lists and Macros to "Mike". Right now I have to manually make those changes and it is a pain in the but.

Thank you

 

[villy]

It hink you can start from here:

Sub dummy()
strCode = "Private Sub Data_" & Sheets(1).Name '& Your code
'then call it through code module
End Sub

If you could share your code so we can play with it..

 

[bishop7262]

It hink you can start from here:

Sub dummy()
strCode = "Private Sub Data_" & Sheets(1).Name '& Your code
'then call it through code module
End Sub

If you could share your code so we can play with it..

This is the code for the macros:

Sub Data_Dan()
'
' Data_Dan Macro
'

'
Sheets("Dan Data").Select
Range("A1").Select
End Sub

---------

Sub Home_Dan()
'
' Home_Dan Macro
'

'
Sheets("Dan").Select
Range("A11").Select
End Sub

---------

The others are just Lists

Thank you

 

[villy]

Run this then look for thisworkbook code:

Sub dummy()
    Dim strCode As String
    Dim FWord As String
    Dim wb As Workbook
    Dim Sh
    Dim i As Integer
    Set wb = ActiveWorkbook
    
    strCode = "Sub Data_" & Sheets(1).Name & vbCr & "'Put your code here " & vbCr & vbCr & _
                "sheets(""" & Sheets(1).Name & " Data"")" & ".Select" & vbCr & "Range(""A1"").Select" & vbCr & _
                "End Sub"
    strHome = "Sub Home_" & Sheets(1).Name & vbCr & "'Put your code here " & vbCr & vbCr & _
                "sheets(""" & Sheets(1).Name & """)" & ".Select" & vbCr & "Range(""A11"").Select" & vbCr & _
                "End Sub"
    'MsgBox strHome
    Debug.Print
    TWB = "ThisWorkbook"
    For i = 1 To wb.VBProject.VBComponents.Count
        If wb.VBProject.VBComponents.Item(i).Name = TWB Then
            Exit For
        End If
    Next
    
    If Not wb.VBProject.VBComponents.Item(i).CodeModule Is Nothing Then
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Data_" & Sheets(1).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strCode)
        End If
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Home_" & Sheets(1).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strHome)
        End If
    End If
    On Error GoTo 0
    Set wb = Nothing
End Sub

 

[bishop7262]

Run this then look for thisworkbook code:

Sub dummy()
    Dim strCode As String
    Dim FWord As String
    Dim wb As Workbook
    Dim Sh
    Dim i As Integer
    Set wb = ActiveWorkbook
    
    strCode = "Sub Data_" & Sheets(1).Name & vbCr & "'Put your code here " & vbCr & vbCr & _
                "sheets(""" & Sheets(1).Name & " Data"")" & ".Select" & vbCr & "Range(""A1"").Select" & vbCr & _
                "End Sub"
    strHome = "Sub Home_" & Sheets(1).Name & vbCr & "'Put your code here " & vbCr & vbCr & _
                "sheets(""" & Sheets(1).Name & """)" & ".Select" & vbCr & "Range(""A11"").Select" & vbCr & _
                "End Sub"
    'MsgBox strHome
    Debug.Print
    TWB = "ThisWorkbook"
    For i = 1 To wb.VBProject.VBComponents.Count
        If wb.VBProject.VBComponents.Item(i).Name = TWB Then
            Exit For
        End If
    Next
    
    If Not wb.VBProject.VBComponents.Item(i).CodeModule Is Nothing Then
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Data_" & Sheets(1).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strCode)
        End If
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Home_" & Sheets(1).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strHome)
        End If
    End If
    On Error GoTo 0
    Set wb = Nothing
End Sub

I cannot get this to work. Getting syntax errors:

Sub dummy()
    Dim strCode As String
    Dim FWord As String
    Dim wb As Workbook
    Dim Sh
    Dim i As Integer
    Set wb = ActiveWorkbook
    
    strCode = "Sub Data_" & Sheets(1).Name & vbCr & "Sub Data_()"
'
' Data_Dan Macro
'

'
Sheets(" Data").Select
Range("A1").Select
End Sub
 " & vbCr & vbCr & _
                "sheets(""" & Sheets(1).Name & " Data"")" & ".Select" & vbCr & "Range(""A1"").Select" & vbCr & _
                "End Sub"
    strHome = "Sub Home_" & Sheets(1).Name & vbCr & "Sub Home_()"
'
' Home_Dan Macro
'

'
Sheets("").Select
Range("A11").Select
End Sub
 " & vbCr & vbCr & _
                "sheets(""" & Sheets(1).Name & """)" & ".Select" & vbCr & "Range(""A11"").Select" & vbCr & _
                "End Sub"
    'MsgBox strHome
    Debug.Print
    TWB = "ThisWorkbook"
    For i = 1 To wb.VBProject.VBComponents.Count
        If wb.VBProject.VBComponents.Item(i).Name = TWB Then
            Exit For
        End If
    Next
    
    If Not wb.VBProject.VBComponents.Item(i).CodeModule Is Nothing Then
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Data_" & Sheets(1).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strCode)
        End If
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Home_" & Sheets(1).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strHome)
        End If
    End If
    On Error GoTo 0
    Set wb = Nothing
End Sub

Now will this work for multiple worksheets where I have to replace names?

 

[villy]

Run this Through Macro (ALT+F8):

Sub dummy()
    Dim strCode, strHome As String
    Dim TWB As String
    Dim wb As Workbook
    Dim Sh
    Dim i As Integer
    Set wb = ActiveWorkbook
    
    For code = 1 To Sheets.Count
    strCode = "Sub Data_" & Sheets(code).Name & vbCr & "'Put your code here " & vbCr & vbCr & _
                "sheets(""" & Sheets(code).Name & " Data"")" & ".Select" & vbCr & "Range(""A1"").Select" & vbCr & _
                "End Sub"
    strHome = "Sub Home_" & Sheets(code).Name & vbCr & "'Put your code here " & vbCr & vbCr & _
                "sheets(""" & Sheets(code).Name & """)" & ".Select" & vbCr & "Range(""A11"").Select" & vbCr & _
                "End Sub"
    
    'MsgBox strHome
    Debug.Print
    TWB = "ThisWorkbook"
    For i = 1 To wb.VBProject.VBComponents.Count
        If wb.VBProject.VBComponents.Item(i).Name = TWB Then
            Exit For
        End If
    Next
    
    If Not wb.VBProject.VBComponents.Item(i).CodeModule Is Nothing Then
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Data_" & Sheets(code).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strCode)
        End If
        If Not wb.VBProject.VBComponents.Item(i).CodeModule.Find("Home_" & Sheets(code).Name, 1, 1, 100, 100) Then
            wb.VBProject.VBComponents.Item(i).CodeModule.AddFromString (strHome)
        End If
    End If
    Next code
    On Error GoTo 0
    Set wb = Nothing
End Sub

Just change the name of each worksheet tab with the name of employee you want...