0

I have a macro written that does a few things. It asks for your first and last name, puts those in cells, colors a couple of the cells, lists today's date and the dates a month from now, 2 months from now, ... , and 12 months from now. I'll stop explaining it there, because that's where my issue comes in.

I need to use a y/n message box to ask the user if they want to the first 6 dates colored red, and another asking if they want the latter 6 dates colored blue. If they select yes for the first one, I'd highlight those 6 dates and change the font. Same for blue. Pretty simple.

I'm getting the message boxes to pop up, but when I select yes - no change to the fonts. The code just continues to move on. The problem starts at the line I have "ColorAsk = MsgBox..."

Sub FirstTrial()
'
' FirstTrial Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'
    Dim FirstName As String
    Dim LastName As String
    Dim Range1 As Range, Data1 As Range
    Dim ColorsAsk As VbMsgBoxResult
    Dim ColorsAsk2 As VbMsgBoxResult
    FirstName = InputBox("Please enter your first name")
    LastName = InputBox("Please enter your last name")
    Range("A1").Select
    ActiveCell.Value = "First Name:"
    Range("A2").Select
    ActiveCell.Value = "Last Name:"
    'Range("B6").Select
    Columns("A:A").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.Value = FirstName
    Range("B2").Select
    ActiveCell.Value = LastName
    Range("A1:A2").Select
    Selection.Font.Bold = True
    Range("B1:B2").Select
    With Selection.Interior 'Puts With in front of each of the following lines
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A3").Select
    ActiveCell.Value = "=TODAY()"
    Set Range1 = Range("A4:A15")
    For Each Data1 In Range1
        Data1 = "=EDATE(R[-1]C,1)"
        Data1.Select
        With Selection
            .NumberFormat = "m/d/yy"
        End With
        Next Data1
    ColorsAsk = MsgBox("Would you like the first 6 months colored red?", vbYesNo + vbDefaultButton1, "Coloring")
        If ColorAsk = 6 Then
        Range("A4:A9").Font.Color = vbRed
        End If
    ColorsAsk2 = MsgBox("Would you like the latter 6 months colored blue?", vbYesNo + vbDefaultButton1, "Coloring")
        If ColorAsk2 = 6 Then
        Range("A10:A15").Font.Color = vbBlue
        End If
    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = FirstName
    Sheets(FirstName).Range("A1:A13").Value = Sheets("Sheet1").Range("A3:A15").Value

End Sub

And a second question - not completely necessary, but would help to know.... The second to last thing this code does is create a worksheet that is named whatever you input as your first name. The last thing this code is supposed to do is copy the calendar from the initial worksheet, and paste it into the newly created worksheet. Right now, I have it doing that under the presumption that the initial sheet will be titled "Sheet1". Is there a way to do it regardless of what the initial sheet's name is?

Cornel Westside
  • 117
  • 1
  • 11
  • 3
    Add `Option Explicit` to the top of the module to catch typos like the ones you've got. You have `ColorsAsk` in the `MsgBox` line and `ColorAsk` in the `If` statement. Same goes for `ColorsAsk2` and `ColorAsk2`. – BigBen Mar 15 '19 at 20:47
  • First, you really want to [avoid using activate and select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code. Second. You should get all the user input at the very beginning of your sub. The rest can all be done afterwards – cybernetic.nomad Mar 15 '19 at 20:51

0 Answers0