Macro to change a date using the +/- keys.

I admittedly know very little in the way of Macros/VBA, but I hope this can be done by borrowing some your expertise.

I have set up a balance sheet for one of my less computer proficient friends. Overall, they love the setup, but they hate having to type in the date for every entry. Apparently, Quickbooks has an option through which you can use a + or a - to change the date up one day or down one day respectively.

My request is the following: I would like for Excel to automatically copy the date from the previous row once a new row is selected. Next, using this information as a basis, I would like the user to be able to press + or - to change the date.

I will attach a sample balance sheet as a reference.

Hi, Bas. You mention in the spreadsheet that the user would like to use the + twice to change the date. The problem with that is that Excel recognizes that as a formula, which causes an error. However, this is possible using a single + or -. The one thing I don't really like about this is if you use ENTER after the + or -, it automatically moves the cursor to the next row, which then populates that date field as well (since the cell in the next row is selected). However, this can be changed in the options so that the cursor moves a different way (e.g. right).

Dim OldVal

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Rng As Range
    Set Rng = Range("A7:A11")
    
    If Not Intersect(Target, Rng) Is Nothing Then
        If IsDate(OldVal) Then
            If Target = "+" Then
                Target = OldVal + 1
            ElseIf Target = "-" Then
                Target = OldVal - 1
            End If
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If IsEmpty(Cells(Target.Row, 1)) Then
        If IsDate(Cells(Target.Row - 1, 1)) Then
            Application.EnableEvents = False
            Cells(Target.Row, 1) = Cells(Target.Row - 1, 1)
            Application.EnableEvents = True
        End If
    End If
    OldVal = Target
End Sub

HTH

Jason

Jason:

Thanks for the help. I would just like to clarify something, because I seem to have been unclear. I do not necessarily want to press + twice to change the date; rather, I would like to use plus to increase the date by 1. (So, if I need to increase the date by two days, I press + twice, 3 days: press + 3 time, etc).

I think the ideal setup I would like (if possible) is something along the lines of the Quickbooks setup. Specifically, the date would be visible, and as I press +, it will automatically increase by one day, while remaining visible. If this cant be done with the + sign, since its a formula key, I don't mind using letters ("a" to increase date by one day, "z" to decrease by one day).

Thanks again for your time.

The procedures I posted will work using the + or - keys. However, it will not work unless the cell value changes (i.e. user presses ENTER, TAB, or uses arrow keys). I am not aware of any event procedures for keydown on the sheet itself.

Jason

Thanks for your help, Jason. I modified that macro somewhat so that "a" and "z" cause the change and if either is pressed more than once, it will add by that amount.

I would like to ask one other question: What if I modified my request slightly? Again, I wonder if this can be done. Can I possible add a new column (before column A) with control buttons. Macros would be assigned to the control buttons, so that if it is clicked, it will automatically add (if the add is clicked) and subtract (if the subtract is clicked). If that can be done, I think it would be a perfect substitute to merely pressing the + or - keys. Also, is there anyway to have these control buttons float so that they are next to the active row (if not, it is no big deal)?

Yes, using control buttons would actually make the code a bit simpler, something like:

Private Sub CommandButton1_Click()
    Dim Cell As Range
    For Each Cell In Selection
        If IsDate(Cell) Then
            Cell = Cell + 1
        End If
    Next Cell
End Sub

Private Sub CommandButton2_Click()
    Dim Cell As Range
    For Each Cell In Selection
        If IsDate(Cell) Then
            Cell = Cell - 1
        End If
    Next Cell
End Sub

I would recommend using a UserForm to include these 2 command buttons, and set it modeless. Unfortunately, I am not familiar with modeless user forms (since my work uses Office 97, and user forms cannot be set modeless in this version), so I do not know how to make it stay next to the selection.

Jason

Jason:

Thanks a lot for your help. When I get home tonight, I will play around with the code you have set up for me, and see if I can get it to go Modeless (google, here I come).

Thanks for the time.

After some consideration, I decided that two command buttons were probably not the best idea; instead, I chose a spin button. I was able to manipulate the code that Jason gave me, along with some codes that I found elsewhere, and I have for the most part what I need. There is only one thing that somewhat annoys me.

When I was working with the Command Buttons, in the properties menu, I had the option to disable "Take focus on Click." I dont want the command button to take the focus. I cannot find this option for the spin button. Is it possible? Do I need to use new code?

Here is what I have so far:

Private Sub SpinButton1_SpinDown()
Dim Cell As Range
    For Each Cell In Selection
        If IsDate(Cell) Then
            Cell = Cell - 1
        End If
    Next Cell

End Sub

Private Sub SpinButton1_SpinUp()
Dim Cell As Range
    For Each Cell In Selection
        If IsDate(Cell) Then
            Cell = Cell + 1
        End If
    Next Cell

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Me.SpinButton1
    .Top = ActiveCell.Top - 5
        End With
    
        If IsEmpty(Cells(Target.Row, 2)) Then
        If IsDate(Cells(Target.Row - 1, 2)) Then
            Application.EnableEvents = False
            Cells(Target.Row, 2) = Cells(Target.Row - 1, 2)
            Application.EnableEvents = True
        End If
    End If
    OldVal = Target
    
End Sub