Now where did DebitbdInput start again?



  • I wouldn't normally think to post VBA code, but considering this is used in an extremely critical process in a large financial organisation I think it qualifies.

    I only looked at the code because I was trying to work out why the flap auto-calculation in Excel had been turned off without notification....

    Code here



  •  Obviously it was made before loops were invented, but atleast it is commented.



  • Please dont tell me a human wrote each and every line of that.



  • Who still pays per line of code these days? 'Cause that would explain a lot...

    Whenever I find this sort of code, it gives me a profound sense of satisfaction to rewrite this using proper loops to 5% of its original size.



  • Ah... you have been tricked!!!  I just went through it (hadn't really bothered working it out before) a loop would not assist.

    As it turns out it refers to named ranges, which are in fact single cells in all cases except one, and only fires the associated sub if you are on that particular cell.  i.e. it is only ever checking the active cell.

    A quick re-write, still ugly but good enough to show what that mess was probably intended to do, is:

     

    Option Explicit

    Sub Auto_Open()

    On Error GoTo Auto_Open_Error
         
        ' set calculation to Manual and don't calculate before saving
        With Application
            .Calculation = xlManual
            .CalculateBeforeSave = False
         End With
     
        ' set a procedure to run on data entry for "PrintSheet"
        Sheets("PrintSheet").OnEntry = "OnEntryProc"
     
      Exit Sub
    Auto_Open_Error:
        Resume
       
    End Sub
    Function OnEntryProc()
        Dim r As Integer
        Dim c As Integer

        If Not Application.Intersect(Range("Input"), ActiveCell) Is Nothing Then
            CheckDetails
        End If
     
        If Not Application.Intersect(Range("audusdnew"), ActiveCell) Is Nothing Then
            Checkaudusdnew
        End If
       
    End Function
    Sub Checkaudusdnew()

    Dim a As Variant
    Dim b As Variant
    Dim c As Variant
    Dim d As Variant
    Dim e As Variant
    Dim f As Variant

    a = Range("audusdnewbuy").Value
    b = Range("audusdoldbuy").Value
    c = Range("audusdnewsell").Value
    d = Range("audusdoldsell").Value

    e = (a - b)
    f = (c - d)
               
    If Abs(e) / b > 0.02 Or Abs(f) / d > 0.02 Then
        Range("audusdnew").Select
        DisplayAlert
    Else
        Range("audusdnew").Select
        Selection.Interior.ColorIndex = xlNone
    End If

    End Sub
    Sub CheckDetails()

        Dim a As Variant
        Dim b As Variant
        Dim c As Variant
       
        a = ActiveCell.Value
        b = Cells(ActiveCell.Row + 39, ActiveCell.Column).Value
        c = (a - b)
       
        If Abs(c) / b < 0.02 Then
            ActiveCell.Interior.ColorIndex = xlNone
        Else
            DisplayAlert
        End If

    End Sub

    Sub DisplayAlert()

    Dim msg, style, title, response, mystring

    msg = "The rate you have entered is > 2% different from the previous day. Is this correct?"
    style = vbYesNo + vbCritical + vbDefaultButton2
    title = "PLEASE CONFIRM RATE"
    response = MsgBox(msg, style, title)

    If response = vbYes Then  'user chose yes
        With ActiveCell.Interior
            .ColorIndex = 35
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    Else   'user chose no
        MsgBox ("Please re-enter the rate")
        With Selection.Interior
            .ColorIndex = 3
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    End If

    End Sub

    Sub CopyToPrevious()
        With Application
            .Calculation = xlAutomatic
            .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = False
        Rows("42:75").Select
        Selection.Delete Shift:=xlUp
        Range("B4:P35").Select
        Selection.Copy
        Range("B43").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Selection.Font.ColorIndex = 11
        Range("Input").Select
        Selection.Interior.ColorIndex = xlNone
        Range("D5").Select
        ActiveWorkbook.Names.Add Name:="AudUsdOld", RefersToR1C1:="=PrintSheet!R44C4"
       
    End Sub



  •  Congratulations on rewriting it!



  • @the code said:

    b = Range("Debitch").Value

    I'm really curious what the value of "debitch" range is.



  • @toth said:

    @the code said:
    b = Range("Debitch").Value

    I'm really curious what the value of "debitch" range is.

     

    Actually this refers to Debbie's Itch, and it ranges from her knees to just under her armpits.



  • @b-redeker said:

    Actually this refers to Debbie's Itch, and it ranges from her knees to just under her armpits.
     

    I'm just going to interpret that as Debbie's "itch" , one that I will be happy to "scratch".



  • What, you've never used a debitcher before? It's a new feature in Visual Studio 2010... instead of pressing F5 to debug, you press Ctrl-Alt-Plural-Zed-Alpha-F5 to debitch... what that does is it comments out all the lines of code that have compiler errors, thus ensuring you get an executable with no bitching from the compiler! Very handy for things like homework assignments :)



  • @ekolis said:

    instead of pressing F5 to debug, you press Ctrl-Alt-Plural-Zed-Alpha-F5 to debitch...

     

    Don't forget to make sure scroll lock is on.


Log in to reply