VBA Macro. Add increment of 1. Transfer data from Sheet 1 to Sheet 2

[rcahayag1925]

Hi Everyone,

I have this data in Sheet1 - RECEIPT

(1) NAME of payor, to be encoded every time clients pays for the service
(2) DATE and TIME
(3) AMOUNT
(4) Receipt Number - should add an increment of 1, upon printing of receipt
example, A pays 950, Receipt Number 501. upon printing receipt the number should be changed to 502

This data should be recorded in Sheet2, every after transactions

DATE/TIME RECEIPT NO. NAME AMOUNT

23 Sep 2018 9:50am 501 A 950
23 Sep 2018 9:55am 502 B 1200
23 Sep 2018 9:59am 503 C 950


Thank you


Rey

 

[gallen]

How do you determine a transaction? Would it be once Name, & Amount are entered? (I assume Date/Time is automatic?)

 

[rcahayag1925]

the name and amount are then entered to the sheet1, for the issuance of the receipt. date/time is automatic

 

[gallen]

I may be missing the point but try this on a copy of your data:

Add this code to your "Receipt" code module. (I'm assuming you know how to do this)

I've commented as much as I can so you can see what each line is doing so you should be able to amend to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)


'This sub assumes Name = Col "A" Date/Time = "B" Amount = "C" & Receipt No = "D"
    
Dim nr As Long ' - Next available row on Sheet 2
Dim wsRecord As Worksheet 'worksheet to write record to.
Dim sRecord As String 'Record to write to wsRecord


    'Has user changed Name or Amount?
    If Target.Column = 1 Or Target.Column = 3 Then
        
        'Are both Name & Amount filled?
        If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
            
            'disable events from triggering
            Application.EnableEvents = False
            
            'if date time is empty, fill it.
            If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "B") = Format(Now, "dd/mm/yyyy hh:mm")
            
             'if Receipt is empty, fill it
            If Cells(Target.Row, "D") = "" Then
                Cells(Target.Row, "D") = Application.WorksheetFunction.Max(Columns("D")) + 1
            End If
            
            'set the record to write
            sRecord = Cells(Target.Row, "B") & " " 'Date/Time
            sRecord = sRecord & Cells(Target.Row, "D") & " " 'Receipt No.
            sRecord = sRecord & Cells(Target.Row, "A") & " " 'Name
            sRecord = sRecord & Cells(Target.Row, "C") ' Receipt No.
            
            
            'get next row on Sheet2
            Set wsRecord = Sheets("Sheet2") 'Change sheet name accordingly.
            
            'Next available row to write to
            nr = wsRecord.Range("A" & Rows.Count).End(xlUp).Row + 1
        
            'Write the record
            wsRecord.Range("A" & nr) = sRecord
                
            'reenable events
            Application.EnableEvents = True
            
        End If
    
    End If
    
End Sub

 

[rcahayag1925]

Thanks Gallen,
i will try to work on this