Below is what I came up with for the decade portion of the project. I'm having issues with menu validation and when it selects the first top 100 it skips the first row. Any help would be great!

Public Sub Menu()
Dim menuOpt As Integer

Dim msg As String

Const minYear As Integer = 1940
Const maxYear As Integer = 2050


msg = "Enter 4 Digit Year (ie 1940) or a single 9 for the Decade (type 777 to end):  "
    menuOpt = 0
    menuOpt = InputBox(msg)
    If menuOpt = 9 Then
        Call decadeProcess(menuOpt)
    End If
    If menuOpt = 777 Then
        Exit Sub
    End If
        
    If menuOpt >= minYear And menInt <= 2050 Then
            Call yearProcess(menuOpt)
    End If
    

    
    

End Sub
Sub decadeProcess(menuOpt As Integer)

Dim i As Integer
Dim setDecade As Integer
Dim setYear As Integer
Dim Lastrow As Long
Dim rng As Range
Dim rng2 As Range
Dim rngFormula As Range
Dim rowData As Long
Dim colData As Long
Dim cnt As Integer




setDecade = 0
setYear = 0
'message = "Decade Process"
'MsgBox (message & "Variable: " & menuOpt)

For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Decade" Then
        exists = True
        Sheets("Decade").Select
        ActiveSheet.Cells.Select
        Selection.ClearContents
    End If
Next i

If Not exists Then
    Worksheets.Add.Name = "Decade"
End If

'Set Decade
Sheets("Master").Select
Sheets("Master").Columns(1).NumberFormat = "0"
Sheets("Master").Columns(2).NumberFormat = "0"
Worksheets("Master").AutoFilterMode = False

setDecade = Worksheets("Master").Range("A1").Value

Do Until setYear = 10
    Sheets("Master").Select
    

          
                           
        With ActiveSheet.Range("A1:M1")
        
             .AutoFilter
             .AutoFilter Field:=1, Criteria1:=setDecade
             .AutoFilter Field:=2, Criteria1:=">=1", _
                Operator:=xlAnd, Criteria2:="<=100"
        
        End With
 
        With ActiveSheet.AutoFilter.Range
         On Error Resume Next
           Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
               .SpecialCells(xlCellTypeVisible)
         On Error GoTo 0
        End With
        
        If rng2 Is Nothing Then
            MsgBox "No data to copy"
        Else
           Lastrow = Worksheets("Decade").Cells(Rows.Count, 1).End(xlUp).Row
            If Lastrow = 1 Then
                Set rng = ActiveSheet.AutoFilter.Range
                rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
                Destination:=Worksheets("Decade").Range("A" & Lastrow)
            Else
                Lastrow = Lastrow + 1
                rng.Offset(1, 0).Resize(rng.Rows.Count - 1) _
                .SpecialCells(xlCellTypeVisible).Copy _
                Destination:=Worksheets("Decade").Range("A" & Lastrow)
            End If
        End If
            'ActiveSheet.ShowAllData

        setYear = setYear + 1
        setDecade = setDecade + 1
Loop

Worksheets("Decade").Activate
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Formula = "=RANDBETWEEN(1,765675765)"
    '   Set the ranges
   Set rng = ActiveCell
    Set rngData = rng.CurrentRegion
    '   Set the row and column variables
   rowData = rngData.CurrentRegion.Rows.Count
    colData = rng.Column

'   Set the formula range and fill down the formula
   Set rngFormula = rngData.Offset(0, colData - 1).Resize(rowData, 1)
    rngFormula.FillDown



    cnt = 0
    Do Until cnt = 2
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    cnt = cnt + 1
    Loop

With ActiveSheet
    .Range("A1").EntireColumn.Delete
End With
    
    Call InsertDecadeDrops
End Sub