Excel: ledger, dynamically creating button

helraizer 1 Light Poster
15 Years Ago
Hi folks,
I have made a ledger sub in Excel. The task is to create a spreadsheet solution for a foreign exchange bureau so each transaction that happens it adds the details to a ledger sheet.
For this I have this code:
Sub ledge()
    Dim r As Excel.Range
    Dim i As Integer
    Dim p As Excel.Range
    Dim q As Excel.Range

     
    If MsgBox("Are you sure you want to make this transaction?", _
    vbYesNo, "System Message") = vbNo Then Exit Sub
       
  i = Worksheets("Home").Range("G64").Value
      
    Set r = Worksheets("ledger").Range("B1").End(xlDown).Offset(1).EntireRow.Cells
    Set p = Worksheets("stock").Range("B1").End(xlDown).Offset(1).EntireRow.Cells
    
     
    With Worksheets("Home")
        If WorksheetFunction.CountA(r) <> 0 Then Exit Sub
          If ((Worksheets("stock").Range("C9").Value - Worksheets("Home").Range("E25").Value) <= 0) Then
       If MsgBox("The number of GBP in stock is too low to make this transaction. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F22").Value = (10000 - Worksheets("stock").Range("C9").Value)
        Worksheets("stock").Range("C9").Value = 10000
            Else: MsgBox "Transaction Cancelled", vbOKOnly, "System Message"
            Exit Sub
    End If
    End If
        r(i, "B").Value = "FXB" & .Range("G64").Value - 3
        r(i, "C").Value = Now()
        r(i, "E").Value = "GBP"
        r(i, "D").Value = .Range("E12").Value
        r(i, "G").Value = .Range("E14").Value
        r(i, "J").Value = .Range("E25").Value
        r(i, "M").Value = .Range("E20").Value
        r(i, "P").Value = .Range("E9").Value
        
    With Worksheets("Home")
        If Worksheets("Home").Range("E12").Value = "USD" Then
        p(3, "C").Value = p(3, "C").Value + .Range("E14").Value
        p(2, "C").Value = p(2, "C").Value - .Range("E25").Value
        p(15, "H").Value = p(15, "H").Value + .Range("E20").Value
        p(15, "C").Value = p(15, "C").Value + .Range("E25").Value
        p(16, "D").Value = p(16, "D").Value + .Range("E14").Value
    
        ElseIf Worksheets("Home").Range("E12").Value = "EUR" Then
          
        p(4, "C").Value = p(4, "C").Value + .Range("E14").Value
        p(2, "C").Value = p(2, "C").Value - .Range("E25").Value
        p(15, "H").Value = p(15, "H").Value + .Range("E20").Value
        p(15, "C").Value = p(15, "C").Value + .Range("E25").Value
        p(17, "D").Value = p(17, "D").Value + .Range("E14").Value
    
        
        ElseIf Worksheets("Home").Range("E12").Value = "YEN" Then
        
        p(5, "C").Value = p(5, "C").Value + .Range("E14").Value
        p(2, "C").Value = p(2, "C").Value - .Range("E25").Value
        p(15, "H").Value = p(15, "H").Value + .Range("E20").Value
        p(15, "C").Value = p(15, "C").Value + .Range("E25").Value
        p(18, "D").Value = p(18, "D").Value + .Range("E14").Value
    
        
        ElseIf Worksheets("Home").Range("E12").Value = "CAD" Then
       
        p(6, "C").Value = p(6, "C").Value + .Range("E14").Value
        p(2, "C").Value = p(2, "C").Value - .Range("E25").Value
        p(15, "H").Value = p(15, "H").Value + .Range("E20").Value
        p(15, "C").Value = p(15, "C").Value + .Range("E25").Value
        p(19, "D").Value = p(19, "D").Value + .Range("E14").Value
    
        
        Else
        
        p(7, "C").Value = p(7, "C").Value + .Range("E14").Value
        p(2, "C").Value = p(2, "C").Value - .Range("E25").Value
        p(15, "H").Value = p(15, "H").Value + .Range("E20").Value
        p(15, "C").Value = p(15, "C").Value + .Range("E25").Value
        p(20, "D").Value = p(20, "D").Value + .Range("E14").Value
   
        End If
           
        MsgBox "The ledger and stock totals have been updated.", vbOKOnly, "System Message"
         
        Application.Goto Worksheets("Home").Range("A1")
        
        
    Worksheets("Home").Range("G64").Value = Worksheets("Home").Range("G64").Value + 1
    
        
         

End With
    End With
    
     If Worksheets("stock").Range("C9").Value <= 1000 Then
    If MsgBox("The number of GBP in stock is too low. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F22").Value = (10000 - Worksheets("stock").Range("C9").Value)
        Worksheets("stock").Range("C9").Value = 10000
            Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C10").Value <= 1000 Then
        If MsgBox("The number of USD in stock is too low. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F23").Value = (10000 - Worksheets("stock").Range("C10").Value)
        Worksheets("stock").Range("C10").Value = 10000
    Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C11").Value <= 1000 Then
    If MsgBox("The number of EUR in stock is too low. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F24").Value = (10000 - Worksheets("stock").Range("C11").Value)
        Worksheets("stock").Range("C11").Value = 10000
    Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C12").Value <= 1000 Then
    If MsgBox("The number of YEN in stock is too low. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F25").Value = (10000 - Worksheets("stock").Range("C12").Value)
        Worksheets("stock").Range("C12").Value = 10000
    Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C13").Value <= 1000 Then
    If MsgBox("The number of CAD in stock is too low. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F26").Value = (10000 - Worksheets("stock").Range("C13").Value)
        Worksheets("stock").Range("C13").Value = 10000
    Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C14").Value <= 1000 Then
    If MsgBox("The number of AUD in stock is too low. Do you want to order some more?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("F27").Value = (10000 - Worksheets("stock").Range("C14").Value)
        Worksheets("stock").Range("C14").Value = 10000
    Else: Exit Sub
    End If
    End If
    
'next step
    
    If Worksheets("stock").Range("C9").Value >= 15000 Then
    If MsgBox("The number of GBP in stock is too high. Holding too much money can pose as a security risk! Do you wish to release some of these funds?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("E22").Value = (Worksheets("stock").Range("C9").Value - 10000)
        Worksheets("stock").Range("C9").Value = 10000
    Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C10").Value >= 15000 Then
    
    If MsgBox("The number of USD in stock is too high. Holding too much money can pose as a security risk! Do you wish to release some of these funds?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("E23").Value = (Worksheets("stock").Range("C10").Value - 10000)
        Worksheets("stock").Range("C10").Value = 10000
    Else: Exit Sub
    End If
    End If
    
    If Worksheets("stock").Range("C11").Value >= 15000 Then
    If MsgBox("The number of EUR in stock is too high. Holding too much money can pose as a security risk! Do you wish to release some of these funds?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("E24").Value = (Worksheets("stock").Range("C11").Value - 10000)
        Worksheets("stock").Range("C11").Value = 10000
    Else: Exit Sub
   End If
   
    If Worksheets("stock").Range("C12").Value >= 15000 Then
    If MsgBox("The number of YEN in stock is too high. Holding too much money can pose as a security risk! Do you wish to release some of these funds?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("E25").Value = (Worksheets("stock").Range("C12").Value - 10000)
        Worksheets("stock").Range("C12").Value = 10000
    Else: Exit Sub
   End If
   End If
   
    If Worksheets("stock").Range("C13").Value >= 15000 Then
    If MsgBox("The number of CAD in stock is too high. Holding too much money can pose as a security risk! Do you wish to release some of these funds?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("E26").Value = (Worksheets("stock").Range("C13").Value - 10000)
        Worksheets("stock").Range("C13").Value = 10000
    Else: Exit Sub
   End If
   End If
   
    If Worksheets("stock").Range("C14").Value >= 15000 Then
    If MsgBox("The number of AUD in stock is too high. Holding too much money can pose as a security risk! Do you wish to release some of these funds?", _
    vbYesNo, "System Message") = vbYes Then
    Worksheets("stock").Range("E27").Value = (Worksheets("stock").Range("C14").Value - 10000)
        Worksheets("stock").Range("C14").Value = 10000
    Else: Exit Sub
    End If
  End If
   End If
     If MsgBox("Would you like to view the receipt?", vbYesNo, "System Message") = vbYes Then
    Set q = Worksheets("Receipt").Range("B1").End(xlDown).Offset(1).EntireRow.Cells
        
        With Worksheets("Home")
        q(3, "F").Value = "FXB" & .Range("G64").Value - 4
        q(8, "F").Value = .Range("E14").Value
        q(10, "F").Value = .Range("E12").Value
        q(13, "F").Value = .Range("E25").Value
        q(15, "F").Value = "GBP"
        q(17, "F").Value = .Range("E20").Value
        q(43, "B").Value = "You were served by " & .Range("E9").Value
        q(44, "B").Value = "You were served on " & Left(Now(), 11) & "at " & Right(Now(), 8)
        
        End With
            
     Application.Goto Worksheets("Receipt").Range("A1")
        
        Else
          Exit Sub
        End If
End Sub
I was thinking of adding a reload for the reciepts, so if the operator presses the button next to a transaction it'll load that data for the reciept.
The code for the reciept is easy, but how would I make it so that, like when it adds the new ledger line, it adds a button into the cell "R"+i (where 'i' is the new line each time) that when pressed loads the data from the same line into the reciept? It'd have to change i each time accordingly with the line it's on..
Any ideas?
Hope that was clear enough,
Sam
visual-basic-6
1 Contributor
0 Replies
75 Views
Be the first to reply
Be a part of the DaniWeb community
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.