CODEWITHSUNDEEP
excel
jrodenhi
jrodenhi

Reputation: 2237

Automatic Decimal Insertion

I do a lot of work with numbers with two places after the decimal. My adding machine has the nice feature that I can enter a string of numbers like 123456 and it automatically inserts the decimal for me and shows it as 1234.56. Excel has a feature under Advanced Options that automatically enters a decimal but it's a global option so not as helpful as it might be. So, I set up some VBA code for the App_SheetChange event handler that will do it for me only on cells that are formatted to show numbers with two decimals. That way, I don't get decimals where I don't want them. The code is pretty simple. It looks like this:

  If InStr(sFormat, "0.00") > 0 Then
    If InStr(".", Source.Formula) = 0 Then
      If IsNumeric(Source.Formula) Then
        s = "00" & Source.Formula
        s = Left(s, Len(s) - 2) & "." & Right(s, 2)
        App.EnableEvents = False
        Source.Formula = CDbl(s)
        App.EnableEvents = True
      End If
    End If
  End If

This works well enough when I am entering data, but if I copy data from another cell, it works if there are significant digits after the decimal but not if it's zeroes. Is there a way to tell if data is being typed into a cell or if it is being pasted from the clipboard?

Upvotes: 0

Views: 179

Answers (2)

jrodenhi
jrodenhi

Reputation: 2237

I guess I have to answer my own question so that I can show my code change, but I am going to accept your answer because most of the key elements were there. I got this to work for both editing and copy/paste. The trick was to recognize when you are pasting. I discovered that I can exit when I am pasting with this line: 

If Application.CutCopyMode <> 0 Then Exit Sub

Here is the code:

Private Sub App_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim s As String
Dim sFormat As String
Dim iPos As Integer
Dim sDate As String
Dim r As Excel.Range
  On Error GoTo ErrHandler:
  If InStr(Source.Formula, "=") > 0 Then Exit Sub
  If Application.CutCopyMode <> 0 Then Exit Sub
  sFormat = Source.NumberFormat
  iPos = InStr(sFormat, ";")
  If iPos > 0 Then sFormat = Left(sFormat, iPos - 1)
  If InStr(sFormat, "0.00") > 0 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each r In Source
        If (IsNumeric(r.Value)) And (InStr(r.Formula, ".") = 0) Then
            If (CDbl(r.Value) = Round(CDbl(r.Value))) Then
                r.Value = r.Value / 100
            End If
        End If
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End If
ErrHandler:
    App.EnableEvents = True
End Sub

This is an event handler (is it called a listener in Excel?) for the App_SheetChange event. I put this code in a Class Module although I am not sure at this point that it is required to do that. I saved that file and then chose it as an Add-In in Excel Options but I would probably have to work at it a bit to remember how I did that. Then I just selected that Add-In to be active and now, with your help, I got it to work. Thank you, @joseph4tw. In my version, I also have some code to put the slashes in dates so you don't have to do that, but I need to test that code now with these improvements to see if it works.

Upvotes: 1

Joseph
Joseph

Reputation: 5160

How about this?

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim r As Excel.Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each r In Target
        If (IsNumeric(r.Value)) Then
            If (CDbl(r.Value) = Round(CDbl(r.Value))) Then
                r.Value = r.Value / 100
            End If
        End If
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

This checks if the cell is numeric and if so, then check if it's a whole number. And if it is, then make it a fraction by dividing by 100. This should be much faster than doing it with String manipulation, which is what you're doing now.

Works well with Copy and Paste as well (even multiple cells).

By the way, you'll need to add this to each sheet you want this to happen with.

EDIT: updated the code to be at the Workbook level

Upvotes: 1

Related Questions