Need help with VBA with adding line item as "transaction data"

[EmmettM]

Hello! Just want to start off by saying thank you in advance if anyone decides to help as I am nowhere near a pro at VBA and am hoping for the best!!

I've created an excel where a customer can input a State, Store, Sale Type, Amount. Due to the complexities of work, there is a corresponding State, Corresponding Store, Corresponding Sale Type, and Corresponding Amount. Meaning there's two transactions for every one transaction. For simplicity it is set up as such:

B2 = State, C2 = Customer Answer
B3 = Store, C3 = Customer Answer
B4 = Sale Type, C4 = Customer Answer
B5 = Amount, C5 = Customer Answer

B7 = Corresponding State, C7 = Customer Answer
B8 = Corresponding Store, C8 = Customer Answer
B9 = Corresponding Sale Type, C9 = Customer Answer
B10 = Corresponding Amount, C10 = Customer Answer

I would like to collect the answers from C2-5 and C7-10 and put them into two separate line items in row format on the next page "sheet 2" in row format. This will be done using an "add transaction button". The point would be they can add as many transactions as they want however they won't override the previous entered items creating a list of transactions.

Any ideas?!

 

[Michael M]

Something like this ??

Sub MM1()
Dim lr As Long
lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:C5").Copy
Sheets("Sheet2").Range("A" & lr + 1).PasteSpecial Transpose:=True
Range("C7:C10").Copy
lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lr + 1).PasteSpecial Transpose:=True
End Sub

 

[Zot]

Here is another longer but easy code that give you possibility to easily modify if you are really new.

You just need to insert any shape to worksheet. Right click and assign the macro below to it.

Sub AddTrans()

Dim DataCount As Long, nRow As Long
Dim rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

' Define variable used for each sheet
Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

' Define variable for range or cells with input data. Combines two different ranges in this case.
Set rngData = Union(ws1.Range("C2", "C5"), ws1.Range("C7", "C10"))

' Count total data entered
DataCount = Application.WorksheetFunction.CountA(rngData)

If DataCount = 8 Then
    ' Get next empty row (will start at line 2 if sheet is blank). Check for last empty row in column A in this case.
    nRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    ' Copy data into two rows each time
    ws2.Range("A" & nRow) = ws1.Range("C2")
    ws2.Range("B" & nRow) = ws1.Range("C3")
    ws2.Range("C" & nRow) = ws1.Range("C4")
    ws2.Range("D" & nRow) = ws1.Range("C5")
    ws2.Range("A" & nRow + 1) = ws1.Range("C7")
    ws2.Range("B" & nRow + 1) = ws1.Range("C8")
    ws2.Range("C" & nRow + 1) = ws1.Range("C9")
    ws2.Range("D" & nRow + 1) = ws1.Range("C10")
Else
    MsgBox "Please enter all data"
End If

End Sub

 

[EmmettM]

Something like this ??

Sub MM1()
Dim lr As Long
lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:C5").Copy
Sheets("Sheet2").Range("A" & lr + 1).PasteSpecial Transpose:=True
Range("C7:C10").Copy
lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lr + 1).PasteSpecial Transpose:=True
End Sub

this worked! Thank you so much! Just one final question, is there a way for me to clear the sheet once the transaction is added?

 

[EmmettM]

Here is another longer but easy code that give you possibility to easily modify if you are really new.

You just need to insert any shape to worksheet. Right click and assign the macro below to it.

Sub AddTrans()

Dim DataCount As Long, nRow As Long
Dim rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

' Define variable used for each sheet
Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

' Define variable for range or cells with input data. Combines two different ranges in this case.
Set rngData = Union(ws1.Range("C2", "C5"), ws1.Range("C7", "C10"))

' Count total data entered
DataCount = Application.WorksheetFunction.CountA(rngData)

If DataCount = 8 Then
    ' Get next empty row (will start at line 2 if sheet is blank). Check for last empty row in column A in this case.
    nRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    ' Copy data into two rows each time
    ws2.Range("A" & nRow) = ws1.Range("C2")
    ws2.Range("B" & nRow) = ws1.Range("C3")
    ws2.Range("C" & nRow) = ws1.Range("C4")
    ws2.Range("D" & nRow) = ws1.Range("C5")
    ws2.Range("A" & nRow + 1) = ws1.Range("C7")
    ws2.Range("B" & nRow + 1) = ws1.Range("C8")
    ws2.Range("C" & nRow + 1) = ws1.Range("C9")
    ws2.Range("D" & nRow + 1) = ws1.Range("C10")
Else
    MsgBox "Please enter all data"
End If

End Sub

Thank you so much for the breakdown! I will definitely keep this for future reference

 

[Michael M]

Use this

Sub MM1()
Dim lr As Long
lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:C5").Copy
Sheets("Sheet2").Range("A" & lr + 1).PasteSpecial Transpose:=True
Range("C7:C10").Copy
lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lr + 1).PasteSpecial Transpose:=True
Range("C2:C5, C7:C10").ClearContents
End Sub