excel 2003 available anywhere?

[eM.XeNoN]

I have an old .xls file with clickable buttons that do not work in openoffice or in office 2010. I know it was made for the older format and hoping to find it somewhere but have been unsuccessful. Anyone out there got a clue?

 

[Mjolnir]

You're sure you don't just have the macros blocked? I thought it was pretty backwards-compatible.


I know I have a copy of 2k3 somewhere at work, so as a last resort I could open it there and at least give you the code from the VBS.

 

[GreyGhost]

$200.00 on Amazon, or go to the TPB "store" for a substantial discount.

 

[FiEND]

like to buy or to 'buy' ? it was posted to newsgroups as recent as yesterday

 

[VonTed]

Who was the time traveling guy? Ask him for a copy!

 

[eM.XeNoN]

http://forums.johnstonefitness.com/attachment.php?attachmentid=5896&d=1113324658

This is the file in question. On the setup page you will see some obvious buttons like "reset spreadsheet" that obviously don't click. Couldn't find it at the "store" either at TPB.

Tryin to get back in shape and I used this before it was awesome.

 

[eM.XeNoN]

buy "buy" doesn't matter. Someone fix it and I paypal a few bucks. Don't really care

 

[FiEND]

works on my office 2010, just had to enable macros

 

[GreyGhost]

http://thepiratebay.se/torrent/4538529/

 

[eM.XeNoN]

well shiet. I only use openoffice not sure how to turn on macros in regular excel.

 

[drake]

euthanize yourself.

 

[Mjolnir]

I'm not going to test these on my work computer without setting up a disposable system/VM/sandbox, but this is the code:

Spoiler

Option Explicit
Sub Auto_Open()
Dim wshexists
Application.ScreenUpdating = False
On Error Resume Next
    Application.Sheets("WL Data").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.Sheets("WL Data").EnableSelection = xlUnlockedCells
    Application.Sheets("WL Data").Select
    Range("J20:J20").Select
    Application.Sheets("Exercise Menu").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.Sheets("Exercise Menu").EnableSelection = xlUnlockedCells
    Application.Sheets("Exercise Menu").Select
    Range("C7:C7").Select
    Application.Sheets("Menu").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.Sheets("Menu").EnableSelection = xlUnlockedCells
    Application.Sheets("Menu").Select
    Range("C5:C5").Select
    Application.ScreenUpdating = True
    
    Set wshexists = Application.Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2))
    If wshexists Then
        Application.Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)).Select
        Application.Range("L6").Select
    Else
        Application.Sheets("Setup").Select
        Range("C9").Select
    End If
End Sub
Sub Reset_Everything()
'
' Reset_Everything Macro
'
Dim iResponse
    On Error Resume Next
    iResponse = MsgBox(Prompt:="Are you sure?" & Chr(13) & _
                               "This will erase all your data." & Chr(13) & _
                               "Only do this if you are preparing for first time use.", _
                               Buttons:=vbOKCancel, Title:="Are You Sure?")
    If iResponse = vbCancel Then
        Exit Sub
    Else
        Sheets("Setup").Range("Myinfo").ClearContents
        Sheets("WL Data").Unprotect
        Sheets("WL Data").Range("H5,H7,I14,a2:C370,H22:N29,H32:N39,H42:N49,H52:N59,H62:N69,H72:N79,H82:N89,H92:N99").ClearContents
        Application.DisplayAlerts = False
        Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)).Delete
        Sheets("Sample Month").Delete
        Application.DisplayAlerts = True
        Sheets("WL Data").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Sheets("WL Data").EnableSelection = xlUnlockedCells
        Sheets("Setup").Range("C9").Select
    End If
End Sub

Sub wld_unprotect()
    Sheets("WL Data").Unprotect
    Range("B2:C370").Select
    Selection.Interior.ColorIndex = xlNone
End Sub
Sub wld_protect()
On Error Resume Next
    Range("B2:C370").Select
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    Sheets("WL Data").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("WL Data").EnableSelection = xlUnlockedCells
    Range("J20:J20").Select
End Sub
Sub New_Month()
'
' New_Month Macro
'
Dim wshexists
    Application.ScreenUpdating = False
    
    If ActiveSheet.Name = "Menu" Then
        MsgBox "This is the Menu Page.  This is the MASTER Daily goals section. You cannot create a new monthly menu from here.  Go to the SETUP page and follow the instructions there.", , "You are on the wrong page to perform this task."
        Exit Sub
    End If
    
    On Error Resume Next
        Set wshexists = Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2))
        If wshexists Then
        MsgBox "Monthly Menu for (" & MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & ") already exists." _
            & (Chr(13)) & (Chr(13)) & "Wait until " & MonthName(Month(Now) + 1, False) & " 1st to create a new menu.", , "Whoops!"
        Exit Sub
    End If
    Sheets.Add().Name = MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)
    Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)).Move After:=Sheets("Menu")
        Columns("A:A").ColumnWidth = 9.57
        Columns("B:B").ColumnWidth = 4.71
        Columns("C:C").ColumnWidth = 8.57
        Columns("D:D").ColumnWidth = 8.57
        Columns("E:E").ColumnWidth = 8.57
        Columns("F:F").ColumnWidth = 8.57
        Columns("G:G").ColumnWidth = 8.57
        Columns("H:H").ColumnWidth = 8.57
        Columns("I:I").ColumnWidth = 6
        Columns("J:J").ColumnWidth = 8.43
        Columns("K:K").ColumnWidth = 7.71
        Columns("L:L").ColumnWidth = 7.57
        Columns("M:M").ColumnWidth = 7.86
        Columns("N:N").ColumnWidth = 6
        Columns("O:O").ColumnWidth = 7.43
        Columns("P:P").ColumnWidth = 7.14
    Sheets("Menu").Rows("431:442").Copy
    'Range([MasterDailyGoals]).Copy
    Selection.Insert
    Application.CutCopyMode = False
    Range("L6").Select
    
    'Sheets("Menu").Rows("431:442").Copy Destination:=ActiveSheet.Rows("1:10")
    Application.ScreenUpdating = True
End Sub
Sub Add_Todays_Menu()
'
    Application.ScreenUpdating = False
    Sheets("WL Data").Unprotect
    Dim varAS
    Dim rg
    Dim bfpkeyed
    Dim bfpentered
    Dim wgt As Range
    Dim bfp As Range
    Dim bmr As Range
    Dim cals As Range
    Dim prot As Range
    Dim carb As Range
    Dim fat As Range
    Dim protpcnt As Range
    Dim carbpcnt As Range
    Dim fatpcnt As Range
    varAS = ActiveSheet.Name
    Set wgt = Range("L6")
    Set bfp = Range("L7")
    Set bmr = Range("L9")
    Set cals = Range("L11")
    Set prot = Range("G9")
    Set carb = Range("G10")
    Set fat = Range("G11")
    Set protpcnt = Range("F9")
    Set carbpcnt = Range("F10")
    Set fatpcnt = Range("F11")
'
' Sanity Check
'
    If ActiveSheet.Name = "Menu" Then
        MsgBox "This is the Menu Page.  This is the MASTER Daily goals section. You cannot create a new daily menu from here.  Go to the current month page, (ex Jun '04).  If there is no current month page, go to the SETUP page and follow the instructions there.", , "You are on the wrong page to perform this task."
        Exit Sub
    End If
    
    If ActiveSheet.Name <> (MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)) Then
        MsgBox "The current month is " & MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & "" _
            & (Chr(13)) & (Chr(13)) & "You are trying to Create Today's Menu in the wrong month." _
            & (Chr(13)) & "Go to the " & MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & " sheet, or create a New Monthly Menu for " & MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & ".", , "Whoops!  You are on the wrong Monthly Menu"
        Exit Sub
    End If
    
    If wgt = "" Then
        MsgBox "You forgot to enter today's Weight", , "Whoops!"
        Exit Sub
    End If
'
' Find todays date on column D on WL Data page
'
    Sheets("WL Data").Select
    Columns("D:D").Select
    Set rg = Cells.Find(What:=Date, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False)
    If rg Is Nothing Then
        Application.ScreenUpdating = True
        MsgBox "Todays date, " & Date & ", does not match any date on the WL Data page, column D ." & (Chr(13)) & _
        "The start date on the setup page cannot be in the future, or more than 12 months in the past." & (Chr(13)) & _
        "If your start date is the upcoming Monday, please wait until Monday to 'create today's menu.'" & (Chr(13)) & (Chr(13)) & _
        "Click OK to go to the setup page and enter a proper start date in the form M/D/YY", , "Whoops!"
    'cleanup
        Sheets("WL Data").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Sheets("WL Data").EnableSelection = xlUnlockedCells
        Application.ScreenUpdating = True
        Set varAS = Nothing
        Sheets("Setup").Select
        Range("C9").Select
        Exit Sub
        'GetColumn = rg.Column
        'GetRow = rg.Row
        'Don't know what you are doing with the row and column info, but it might go here
    End If
    
'
' Add Todays Menu
'
    Sheets("Menu").Select
    Rows("401:425").Copy
    Sheets([varAS]).Select
    Rows("14:14").Select
    Selection.Insert Shift:=xlDown
    
    Sheets("Menu").Select
    Range("J405:P405").Copy
    Sheets([varAS]).Select
    Range("J18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
' VB.Clipboard.Clear
'
    'must figure out how to do this!
'
' Copy Today's Weight from Current Month Menu to WL Data Worksheet
'
    Sheets([varAS]).Select
    wgt.Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("P15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("WL Data").Select
    
    Range("I14").Select
    ActiveCell.FormulaR1C1 = Date
    
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    rg.Offset(0, -2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
' Copy Today's Body Fat %age from Current Month Menu to WL Data Worksheet
'
    Sheets([varAS]).Select
    bfp.Select
    If ActiveCell.Value = "" Then bfpkeyed = "no"
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("P16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("WL Data").Select
    Range("H7").Select
'If you keyed bfp, then populate the WLD page, otherwise leave the old values
    If bfpkeyed <> "no" Then
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
        rg.Offset(0, -1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If

'
' Populate Calories, Fats, Carbs, Protien, BMR in Today's Menu
'
'Calories
    Sheets([varAS]).Select
    cals.Select
    Selection.Copy
    Range("J19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Protien
    prot.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("P19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    protpcnt.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Carbs
    carb.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    carbpcnt.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Fat
    fat.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("K19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    fatpcnt.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'BMR
    bmr.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("P37").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
' VB.Clipboard.Clear
'

'
' Populate date in Today's Menu
'
    Sheets([varAS]).Select
    Range("C18").Select
    ActiveCell.FormulaR1C1 = Date
'
' Cleanup
'
    Sheets([varAS]).Select
    wgt.Select
    Selection.ClearContents
    bfp.Select
    Selection.ClearContents
    Set varAS = Nothing
    Set rg = Nothing
    Set wgt = Nothing
    Set bfp = Nothing
    Set bmr = Nothing
    Set cals = Nothing
    Set prot = Nothing
    Set carb = Nothing
    Set fat = Nothing
    Set protpcnt = Nothing
    Set carbpcnt = Nothing
    Set fatpcnt = Nothing
    Set bfpentered = Nothing
    Sheets("WL Data").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("WL Data").EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = True
    Range("B20").Select
End Sub
Sub Import()
'
' Macro to Import from old version, Experimental
'
Dim Lastrow, varNo1, xName
Dim i, x, currentmonthexists
Dim yr, mn
Dim wshexists, Unprotect
Dim source, target, source1, sourcefullpath
Dim OldVersion
Dim wldata, menucal, wdcurrentdate, exmenucardio, exmenuweights, msmnts
On Error Resume Next

target = ActiveWorkbook.Name
sourcefullpath = Application.GetOpenFilename("Excel files (*.xl*),*.xl*", 1, "Open the SOURCE file you are importing FROM (the old version).", , False)
If sourcefullpath = False Then
MsgBox "The Cancel button was selected.", vbCritical, "Import Cancelled"
Exit Sub
End If

source = sourcefullpath
    i = InstrRev(source, "\")
    If i > 0 Then
        source = Mid(source, i + 1)
    End If
Workbooks.Open Filename:=sourcefullpath
    Windows(source).Activate
    Sheets("Setup").Select
    Range("n2").Select
OldVersion = ActiveCell.Value
'MsgBox OldVersion
       
'Prep old version by temporarily removing name references
    Windows(source).Activate
    For Each xName In ActiveWorkbook.Names
        xName.Delete
    Next xName

'Old Monthly Menus
    For i = 1 To 36
        x = 36 - i
        yr = Year(Now)
        mn = Month(Now) - x
        If mn > -12 And mn < 1 Then
            mn = mn + 12
            yr = yr - 1
        ElseIf mn > -24 And mn < -11 Then
            mn = mn + 24
            yr = yr - 2
        ElseIf mn > -36 And mn < -23 Then
            mn = mn + 36
            yr = yr - 3
        End If
    Windows(source).Activate
    Set wshexists = Nothing
    Set wshexists = Sheets(MonthName(mn, True) & " '" & Right(yr, 2))
If wshexists Is Nothing Then
    'MsgBox "Monthly Menu (" & MonthName(mn, True) & " '" & Right(yr, 2) & ") doesnt exist, so cant import."
Else
    Windows(source).Activate
    wshexists.Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    wshexists.Copy After:=Workbooks(target).Sheets("menu")
If x = 0 Then
    Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)).Name = MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & " (Imported)"
    currentmonthexists = True
End If
    
    Windows(target).Activate
    ActiveSheet.Shapes("Group 1").Select
    Selection.ShapeRange.Ungroup.Select
    ActiveSheet.Shapes("Text Box 2").Select
    Selection.OnAction = "Add_Todays_Menu"
    ActiveSheet.Shapes("Text Box 3").Select
    Selection.OnAction = "New_Month"
    
    Cells.Select
    With Selection.Validation
    .Delete
    End With
    
    Range("A1").Select
End If
Next i
i = Nothing
x = Nothing
    
'Current Monthly Menu
    Windows(target).Activate
    Application.Run ("New_Month")
    
    If currentmonthexists = True Then
        If OldVersion = "v 2.03" Or OldVersion = "v 2.03" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then
            'Do nothing.  Daily menus dont match and can't be combined together.
        ElseIf OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Or OldVersion = "v 2.05" Or OldVersion = "v 2.04" Then
            
        'Copy current month (imported) data
        Application.Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & " (Imported)").Select
        Rows("14:999").Select
        Selection.Copy
        
        'Paste current month (imported) data to Current Month
        Application.Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2)).Select
        Rows("14:14").Select
            Selection.Paste
        
        'Label current month (imported) data as non modifiable
        Rows("14:14").Select
            Selection.Insert Shift:=xlDown
            Selection.Font.Bold = False
            ActiveCell.FormulaR1C1 = _
                "Imported Data Below.  The data below has been imported from a previous version of this program and is no longer modifiable.  It can be viewed but not changed."
            With ActiveCell.Characters(Start:=1, Length:=20).Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 3
            End With
            With ActiveCell.Characters(Start:=21, Length:=138).Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 3
            End With
            Range("L6").Select
        'Delete current month (imported) sheet
            Application.DisplayAlerts = False
                Application.Sheets(MonthName(Month(Now), True) & " '" & Right(Year(Now), 2) & " (Imported)").Delete
            Application.DisplayAlerts = True
        End If
    End If

    

'WLD Page
If OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Or OldVersion = "v 2.05" Or OldVersion = "v 2.04" Or OldVersion = "v 2.03" Then wldata = "WL Data"
If OldVersion = "v 2.02" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then wldata = "Weight Loss Data"

If OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Or OldVersion = "v 2.05" Or OldVersion = "v 2.04" Or OldVersion = "v 2.03" Or OldVersion = "v 2.02" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Then Unprotect = "yes"
If OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then Unprotect = "no"

    Windows(target).Activate
    Sheets("WL Data").Select
    Application.Run ("wld_unprotect")
    
    Windows(source).Activate
        If wldata = "WL Data" Then Sheets("WL Data").Select
        If wldata = "Weight Loss Data" Then Sheets("Weight Loss Data").Select
    If Unprotect = "yes" Then Application.Run ("wld_unprotect")
    If Unprotect = "yes" Then Range("A2:C370").Select
    If Unprotect = "no" Then ActiveSheet.Unprotect
    If Unprotect = "no" Then Range("A2:C370").Select
    Selection.Copy
    Windows(target).Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows(source).Activate
    Range("H5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows(source).Activate
    Range("H7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
If OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Then wdcurrentdate = 14
If OldVersion = "v 2.05" Or OldVersion = "v 2.04" Or OldVersion = "v 2.03" Or OldVersion = "v 2.03" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then wdcurrentdate = 15
    
    Windows(source).Activate
        If wdcurrentdate = 14 Then Range("I14").Select
        If wdcurrentdate = 15 Then Range("I15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("I14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
If OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Or OldVersion = "v 2.05" Or OldVersion = "v 2.04" Or OldVersion = "v 2.03" Or OldVersion = "v 2.02" Then msmnts = 22
If OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then msmnts = 21
    
    Windows(source).Activate
    If msmnts = 22 Then Range("H22:N29").Select
    If msmnts = 21 Then Range("H21:N28").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H22:N29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H32:N39").Select
    If msmnts = 21 Then Range("H31:N38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H32:N39").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H42:N49").Select
    If msmnts = 21 Then Range("H41:N48").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H42:N49").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H52:N59").Select
    If msmnts = 21 Then Range("H51:N58").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H52:N59").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H62:N69").Select
    If msmnts = 21 Then Range("H61:N68").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H62:N69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H72:N79").Select
    If msmnts = 21 Then Range("H71:N78").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H72:N79").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H82:N89").Select
    If msmnts = 21 Then Range("H81:N88").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H82:N89").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows(source).Activate
    If msmnts = 22 Then Range("H92:N99").Select
    If msmnts = 21 Then Range("H91:N98").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(target).Activate
    Range("H92:N99").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Application.Run ("wld_protect")

'Exercise Menu Page
    Windows(source).Activate
    Sheets("Exercise Menu").Select
    ActiveSheet.Unprotect
    Windows(target).Activate
    Sheets("Exercise Menu").Select
    ActiveSheet.Unprotect

'Cardio
If OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Then exmenucardio = 99
If OldVersion = "v 2.05" Or OldVersion = "v 2.04" Then exmenucardio = 90
If OldVersion = "v 2.03" Or OldVersion = "v 2.03" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Then exmenucardio = 20
If OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then
MsgBox "Versions 1.09 and prior do not contain an cardio menu."
Else
    Windows(source).Activate
    Sheets("Exercise Menu").Select
        If exmenucardio = 99 Then Range("C7:I99").Select
        If exmenucardio = 90 Then Range("C6:I90").Select
        If exmenucardio = 20 Then Range("C6:I20").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Exercise Menu").Select
    Range("C7").Select
    ActiveSheet.Paste
End If

'Weights
If OldVersion = "v 2.08" Or OldVersion = "v 2.07" Or OldVersion = "v 2.06" Then exmenuweights = 199
If OldVersion = "v 2.05" Or OldVersion = "v 2.04" Or OldVersion = "v 2.03" Or OldVersion = "v 2.03" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then
MsgBox "Versions 2.05 and prior do not contain a compatible weights menu."
Else
    Windows(source).Activate
    Sheets("Exercise Menu").Select
        If exmenuweights = 199 Then Range("C105:I199").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Exercise Menu").Select
    Range("C105").Select
    ActiveSheet.Paste
End If
Range("C7").Select

'Menu Page
    Windows(source).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    
For i = 5 To 399
varNo1 = "c" & i & ":i" & i
Range([varNo1]).Select
    Selection.Locked = False
    Selection.UnMerge
Next i
If OldVersion = OldVersion = "v 2.08" Or "v 2.07" Or OldVersion = "v 2.06" Or OldVersion = "v 2.05" Or OldVersion = "v 2.04" Then menucal = "j"
If OldVersion = "v 2.03" Or OldVersion = "v 2.02" Or OldVersion = "v 2.01" Or OldVersion = "v 2.0" Or OldVersion = "v 1.09" Or OldVersion = "v 1.08" Or OldVersion = "v 1.07" Or OldVersion = "v 1.06" Or OldVersion = "v 1.05" Or OldVersion = "v 1.04" Or OldVersion = "v 1.03" Or OldVersion = "v 1.02" Or OldVersion = "v 1.01" Or OldVersion = "v 1.0" Then menucal = "d"
'  MsgBox menucal
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C5:C49").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("C5").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D5:J49").Select
        If menucal = "j" Then Range("J5:P49").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J5").Select
    ActiveSheet.Paste
    
    
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C51:C99").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C51").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D51:J99").Select
        If menucal = "j" Then Range("J51:P99").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J51").Select
    ActiveSheet.Paste
    
    
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C101:C149").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C101").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D101:J149").Select
        If menucal = "j" Then Range("J101:P149").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J101").Select
    ActiveSheet.Paste
    
    
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C151:C199").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C151").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D151:J199").Select
        If menucal = "j" Then Range("J151:P199").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J151").Select
    ActiveSheet.Paste
      
      
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C201:C249").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C201").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D201:J249").Select
        If menucal = "j" Then Range("J201:P249").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J201").Select
    ActiveSheet.Paste
    
    
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C251:C299").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C251").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D251:J299").Select
        If menucal = "j" Then Range("J251:P299").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J251").Select
    ActiveSheet.Paste


    Windows(source).Activate
    Sheets("Menu").Select
    Range("C301:C349").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C301").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D301:J349").Select
        If menucal = "j" Then Range("J301:P349").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J301").Select
    ActiveSheet.Paste
    
    
    Windows(source).Activate
    Sheets("Menu").Select
    Range("C351:C399").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    ActiveSheet.Unprotect
    Range("C351").Select
    ActiveSheet.Paste
    
    Windows(source).Activate
    Sheets("Menu").Select
        If menucal = "d" Then Range("D351:J399").Select
        If menucal = "j" Then Range("J351:P399").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Windows(target).Activate
    Sheets("Menu").Select
    Range("J351").Select
    ActiveSheet.Paste

Application.ScreenUpdating = False
For i = 5 To 399
    varNo1 = "c" & i & ":i" & i
    Range([varNo1]).Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Locked = False
        Selection.FormulaHidden = False
        Selection.Merge
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
Next i
Application.ScreenUpdating = True

Range("C5").Select

'Finish Up
Sheets(MonthName(Month(Now) - x, True) & " '" & Right(Year(Now), 2)).Select
Workbooks(source).Close SaveChanges:=False
Application.Run ("Auto_Open")
MsgBox "Import Complete.  Your new file and old file will now close." & Chr(13) & "Immediately open your new file and check the data for errors.", , "Import Complete"
Workbooks(target).Close SaveChanges:=True
Workbooks(target).Open

End Sub

Function InstrRev(StringCheck, StringMatch, Optional Start = -1, Optional Compare = vbBinaryCompare)

    Dim index As Long
    Dim lastIndex As Long
    
    If Start > Len(StringCheck) Then
        ' this is probably a quirk in VB6's InstrRev function: when
        ' start is higher than the source string length, the function
        ' returns zero
        Exit Function
    ElseIf Start < 0 Then
        ' if Start is omitted, last valid index is the end of string
        lastIndex = Len(StringCheck)
    Else
        ' else, we must account for the length of the searched string
        ' (this is the way VB6's InstrRev function works)
        lastIndex = Start + 1 - Len(StringMatch)
    End If
    
    Do
        index = InStr(index + 1, StringCheck, StringMatch, Compare)
        ' exit if not found, or if it's past the start index
        If index = 0 Or index > lastIndex Then Exit Do
        ' remember the index we've just found
        InstrRev = index
    Loop
    
End Function

Function MonthName(mnth, Optional shortened As Boolean)
If shortened = False Then
    If mnth = 1 Then MonthName = "January"
    If mnth = 2 Then MonthName = "February"
    If mnth = 3 Then MonthName = "March"
    If mnth = 4 Then MonthName = "April"
    If mnth = 5 Then MonthName = "May"
    If mnth = 6 Then MonthName = "June"
    If mnth = 7 Then MonthName = "July"
    If mnth = 8 Then MonthName = "August"
    If mnth = 9 Then MonthName = "September"
    If mnth = 10 Then MonthName = "October"
    If mnth = 11 Then MonthName = "November"
    If mnth = 12 Then MonthName = "December"
Else
    If mnth = 1 Then MonthName = "Jan"
    If mnth = 2 Then MonthName = "Feb"
    If mnth = 3 Then MonthName = "Mar"
    If mnth = 4 Then MonthName = "Apr"
    If mnth = 5 Then MonthName = "May"
    If mnth = 6 Then MonthName = "Jun"
    If mnth = 7 Then MonthName = "Jul"
    If mnth = 8 Then MonthName = "Aug"
    If mnth = 9 Then MonthName = "Sep"
    If mnth = 10 Then MonthName = "Oct"
    If mnth = 11 Then MonthName = "Nov"
    If mnth = 12 Then MonthName = "Dec"
End If
End Function

 

[drake]

MsgBox "Todays date, " & Date & ", Yep, you are still fat , column D ." & (Chr(13)) & _"

 

[eM.XeNoN]

MsgBox "Todays date, " & Date & ", Yep, you are still fat , column D ." & (Chr(13)) & _"

Correct! Less fat but still fat.

 

[eM.XeNoN]

Hmm just reinstalled and it works. No option at all to fix macros before so I wasn't a complete moron. Now off to being less of a fatty!

Thanks for the prod in the right direction.