need help! with VBA code, almost done....

[RompStar]

This code is my main driver code, it opens 3 driver workbooks and glues like stores numbers together and then it finds the store number path and exports it.

As a very last step, I insert SORT code VBA into module (works) and then put buttons on the sheets 2 to last sheet (skipping sheet 1), that also works.

But when I open one of the processes stores Workbooks that wbNew is doing and press the SORT button, it is referencing the driver workbook that processes these and wbNew its self.

That is the problem that I am having...

See the ---- +++++++++ below, that's where I am having problems, probbly something simple, but been staring at it for tooo long, need a break

Sub copy_like_sheets_to_output_folder()

    Dim FName As String ' this is so that we can copy the module into the new sheets (hold button sort code)
    Dim VBP As Object    ' as VBProject
    Dim mylog(1 To 600)  ' 200 times 3 passes, for 600, extra, just incase
    Dim StoreDir, StoreDir2 As String
    Dim i As Long, j As Long
  '  Dim strSavePath As String
    Dim wbNew As Workbook, wsCopy As Worksheet
    Dim wbDriver(1 To 3) As Workbook
    Dim IDwbDriver$()
    Dim vStores As Variant     ' List of all the created files
    Dim phone_guide, pull_downs As Workbook         ' This is used to copy and glue the Phone_Guidelines sheet after all possible 1-3 sheet combinations
    Dim endoffilename As String
    
    endoffilename = InputBox("Enter the name of the Excel file name to be used [without] the Store number, [without] the file extension, " _
& "[with] the destroy date.")

    Dim StartTime, EndTime, TotalTime As Double

    StartTime = Now
    
    StoreDir2 = "c:\Documents and Settings\id\Desktop\error1004\GC\"  ' incase we have store folders that have not been setup
    
    Set phone_guide = Workbooks.Open(Filename:="C:\Documents and Settings\id\Desktop\gc_dictionary.xls")
       
    ' Open the 3 driver Workbooks
 '   Set wbDriver(1) = Workbooks.Open(Filename:="C:\AAA_3_Workbooks\RRN_Book1_5stores.xls") ' use to test of a smaller set to find bugs quicker
 '   Set wbDriver(2) = Workbooks.Open(Filename:="C:\AAA_3_Workbooks\CON_Book2_5stores.xls")
 '   Set wbDriver(3) = Workbooks.Open(Filename:="C:\AAA_3_Workbooks\RRP_Book3_5stores.xls")
    
    Set wbDriver(1) = Workbooks.Open(Filename:="C:\AAA_3_Workbooks\RRN_Book1.xls") ' once works, use to test on the bigger set of all stores
    Set wbDriver(2) = Workbooks.Open(Filename:="C:\AAA_3_Workbooks\CON_Book2.xls")
    Set wbDriver(3) = Workbooks.Open(Filename:="C:\AAA_3_Workbooks\RRP_Book3.xls")
    
    Set thiswb = Workbooks("3_AlpahFrog_2nd_attempt_USETHIS_FINAL.xls")
    
    ReDim IDwbDriver(LBound(wbDriver) To UBound(wbDriver))
    For i = LBound(wbDriver) To UBound(wbDriver)
        IDwbDriver(i) = Left(wbDriver(i).Name, 3)           'RNN, CON, RRP   'Grabs the first 3 strings from the drivers above
    Next i
    
  '  strSavePath = "C:\AAA_3_Workbooks\OUTPUT\"                                ' Path to save new workbooks
  '  If Dir(strSavePath, vbDirectory) = vbNullString Then MkDir strSavePath    ' Make directory if it doesn't already exist

    Application.SheetsInNewWorkbook = 1
    Application.ScreenUpdating = False
    
    For i = LBound(wbDriver) To UBound(wbDriver)
    
        For Each ws In wbDriver(i).Worksheets
        
            If InStr(vStores, ws.Name) = 0 Then vStores = vStores & ws.Name & ","           'remember created store files
            
            If Dir(strSavePath & ws.Name & ".xls", vbDirectory) = vbNullString Then         'File doesn't already exist
                
                Set wbNew = Application.Workbooks.Add
                ws.Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
                
' adjust to comply with sheet name changes
If IDwbDriver(i) = "RRN" Then
    IDwbDriver(i) = "Prospect"
ElseIf IDwbDriver(i) = "CON" Then
    IDwbDriver(i) = "Connected"
ElseIf IDwbDriver(i) = "RRP" Then
    IDwbDriver(i) = "RR Prev Contact"
End If
                
                wbNew.Sheets(wbNew.Sheets.Count).Name = ws.Name & " " & IDwbDriver(i)    ' Store# +space+ Driver_Label (see above IF elseIf End)

                For j = LBound(wbDriver) To UBound(wbDriver)
                    If j <> i Then
                    
                    If IDwbDriver(j) = "RRN" Then
                        IDwbDriver(j) = "Prospect"
                    ElseIf IDwbDriver(j) = "CON" Then
                        IDwbDriver(j) = "Connected"
                    ElseIf IDwbDriver(j) = "RRP" Then
                        IDwbDriver(j) = "RR Prev Contact"
                    End If
                        
                        Set wsCopy = Nothing
                        On Error Resume Next
                        Set wsCopy = wbDriver(j).Sheets(ws.Name)                ' look for the same "Store" in other workbook
                        On Error GoTo 0

                        If Not wsCopy Is Nothing Then                           ' the "Store" exists in other workbook then copy it
                            wsCopy.Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
                            wbNew.Sheets(wbNew.Sheets.Count).Name = wsCopy.Name & " " & IDwbDriver(j)
                        End If
                    End If
                Next j
                
                Application.DisplayAlerts = False
                wbNew.Sheets(1).Delete
                Application.DisplayAlerts = True
                
                
StoreDir = ws.Name
    On Error GoTo ErrHandler
    
Select Case StoreDir
        Case Is = 1, 2, 3, 4, 5 
    StoreDir = "\\path\on\network\drive" & ws.Name & "\PROGRAM\"

        Case Else
    StoreDir = "c:\Documents and Settings\id\Desktop\no_sheet_match\"
End Select
                              
                phone_guide.Sheets("Call or Address List Guidelines").Copy Before:=wbNew.Sheets(1) ' Paste the Phone_Guidelines Sheet
                
               
With thiswb ' export the code for Module1 and ThisWorkbook into temp .txt files
   FName = .Path & "\code.txt"   ' just export the module for the SORTS, This workbook won't work anyways without the Virus Scanner turned OFF
End With

    wbNew.VBProject.VBComponents.Import FName   ' import the contents of code.txt into Module1 of the new sheets

wbNew.SaveAs Filename:=StoreDir & "Store_" & ws.Name & endoffilename & ".xls"
    
    
myCount = Application.Sheets.Count

For r = 2 To myCount




' +++++++++++++++++++++++++++++
'  HERE is where I need help with, the buttons as they are added need to reference the new
' document created and not:
' Workbooks ("3_AlpahFrog_2nd_attempt_USETHIS_FINAL.xls")







    With wx
    Application.Sheets(r).Select
    
    On Error Resume Next
Application.Sheets(r).Unprotect Password:=("password") ' unprotect the sheet

' insert the buttons here

With Application.Sheets(r)

    .Range("D3").Select
    .Buttons.Add(11.25, 18, 136.5, 65.25).Select
    Selection.OnAction = "ORG_SORT"
    .Shapes("Button 1").Select
    Selection.Characters.Text = "Original SORT"
    With Selection.Characters(Start:=1, Length:=13).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    .Range("O3").Select
    .Buttons.Add(1263, 43.5, 111, 47.25).Select
    Selection.OnAction = "email_available_SORT"
    .Shapes("Button 2").Select
    Selection.Characters.Text = "Email Available SORT" & Chr(10) & "Descending"
    With Selection.Characters(Start:=1, Length:=31).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    .Range("R4").Select
    .Buttons.Add(2010, 42.75, 128.25, 48).Select
    Selection.OnAction = "Total_Spend_Indicator_SORT"
    .Shapes("Button 3").Select
    Selection.Characters.Text = "High Spend SORT" & Chr(10) & "Descending"
    With Selection.Characters(Start:=1, Length:=26).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    .Range("T4").Select
    .Buttons.Add(2143.5, 45, 119.25, 45.75).Select
    Selection.OnAction = "Date_of_Prospect_SORT"
    .Shapes("Button 4").Select
    Selection.Characters.Text = "Date of Prospect SORT" & Chr(10) & "Ascending"
    With Selection.Characters(Start:=1, Length:=31).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    .Range("AB2").Select
    .Buttons.Add(2672.25, 48, 132, 44.25).Select
    Selection.OnAction = "GO_TO_PERSON_SORT"
    .Shapes("Button 5").Select
    Selection.Characters.Text = "Go-To-Person SORT" & Chr(10) & "Descending"
    With Selection.Characters(Start:=1, Length:=28).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    .Range("AB2").Select
    ActiveWindow.SmallScroll ToRight:=2
    .Buttons.Add(2811.75, 48, 91.5, 45).Select
    Selection.OnAction = "New_or_Existing_SORT"
    .Shapes("Button 6").Select
    Selection.Characters.Text = "N/E SORT" & Chr(10) & "Descending"
    With Selection.Characters(Start:=1, Length:=19).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    .Range("AD4").Select
    
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=("password")  'protect it back

    End With

    End With
Next r
 
wbNew.SaveAs Filename:=StoreDir & "Store_" & ws.Name & endoffilename & ".xls"
  
                wbNew.Close SaveChanges:=False
                Set wbNew = Nothing
                
z = z + 1
mylog(z) = StoreDir & "Store_" & ws.Name & endoffilename & ".xls"

1:
                
            End If
        
        Next ws
        
    Next i
     
thiswb.Activate
       
    For i = LBound(wbDriver) To UBound(wbDriver)
       wbDriver(i).Close SaveChanges:=False
    Next i
    
    phone_guide.Close SaveChanges:=False ' close the Phone_Guidelines and Pull Down sheet
    
    Application.SheetsInNewWorkbook = 3
    Application.ScreenUpdating = True
    
' +++++++++++++++++++++++++++++++++++++ LOG GENERATION on sheet(1) ++++++++++++++++++++++++++++++

        With Workbooks("3_AlpahFrog_2nd_attempt_USETHIS_FINAL.xls")

Set logsheet = Sheets.Add ' Add the sheet as Object
logsheet.Name = "Log"     ' Give the new sheet name "Log"
Sheets("Log").Move Before:=Sheets(1) ' Make sure the new sheet Log is the first one user sees
logsheet.Range("A1").Value = ("Location the Store folders were written to:") ' add header for column A

logsheet.Range("A2:A" & UBound(mylog) + 1) = WorksheetFunction.Transpose(mylog) ' paste the contents of the array

End With

Erase mylog() ' deletes the array contents

GoTo 2 ' used to skip the ErrorHandler if no errors, otherwise, it will get confused as to what it is supposed to do

' +++++++++++++++++++++++++++++++ START ERROR HANDLER
ErrHandler: 'Handles Errors

If Err.Number = 400 Then
If MsgBox("Error 400 is caused most likely when Excel encounters a none-number in the sheets that " _
& "it is trying to process and it doesn't know what to do with sheet called 'data'.  This error is normal, So Press Yes to " _
& "Continue or No if you want to Stop", vbYesNo) = vbYes Then
            Resume 1
         Else
            MsgBox "The message text of the error is: " & Error(Err)
         End If
End If
      
If Err.Number = 1004 Then
wbNew.SaveCopyAs Filename:=StoreDir2 & "Store_" & ws.Name & endoffilename & ".xls"
    z = z + 1
    mylog(z) = StoreDir2 & "Store_" & ws.Name & endoffilename & ".xls"
wbNew.Close SaveChanges:=False
Set wbNew = Nothing
    Resume 1
End If
' ++++++++++++++++++++++++++++++++ END ERROR HANDLER

2:

EndTime = Now
TotalTime = EndTime - StartTime
MsgBox "Finished! Look at log sheet. Time elapsed in HH, MM, SS:" & vbCrLf & Format(TotalTime, "HH:MM:SS")

End Sub