[VBA]Copy data from specify cell and input value to another sheet with time stamp

[maiwarits]

Hello Sir,

I have a simple stock that I have consult with our board before.

For now, I would like to create a time stamp, copy name in column C and input data to another sheet when user has click OK button.

Example:
If I input 10 in the box and click OK, It will store like in the result picture.

Input 10	current result

Next, After I click OK then store the result finish, I would like to create time stamp in TimeStamp work sheet in every click OK.
Example: Result should be like this in TImeStamp worksheet.

Here is my code and file My file.
I have try to create the time stamp as you can see in the code. But it not working as my expected

Sub addStock()

Dim balanceStock As Double
Dim Col As Integer
'Check imput Applies columns E & F only
If ActiveCell.Column < 5 Or ActiveCell.Column > 6 Then Exit Sub

'Find current mont
Col = 2 * Month(Now) + 6

balanceStock = InputBox("Amount?")

With ActiveCell
    .Value = .Value + balanceStock
    If balanceStock < 0 Then Col = Col + 1
    Cells(.Row, Col) = Cells(.Row, Col) + balanceStock
End With

'Copy and time stamp (not working now)
    Dim wsYearlyStock As Worksheet 'define source sheet
        Set wsYearlyStock = ThisWorkbook.Worksheets("YearlyStock")

    Dim wsTimeStamp As Worksheet 'define destination sheet
        Set wsTimeStamp = ThisWorkbook.Worksheets("TimeStamp")
    
    Dim DestRow As Long
    DestRow = 2 'start in row 5 in destination sheet
    
    Dim Rng As Range
    For Each Rng In Selection.Areas
        Rng.Resize(, 1).Copy Destination:=wsTimeStamp.Cells(DestRow, "C") 'copy A to B
        DestRow = DestRow + Rng.Rows.Count 'move DestRow to next free row
    Next Rng

End Sub

 

[MikeVol]

Hello @maiwarits. If I understand you correctly, here is an option:

Option Explicit

Sub addStock()

    ' Check input Applies columns E & F only
    If ActiveCell.Column < 5 Or ActiveCell.Column > 6 Then Exit Sub

    ' Find current month
    Dim Col         As Long: Col = 2 * Month(Now) + 6
    Dim balanceStock As Double: balanceStock = InputBox("Amount?")

    With ActiveCell
        .Value = .Value + balanceStock
        If balanceStock < 0 Then Col = Col + 1
        Cells(.Row, Col) = Cells(.Row, Col) + balanceStock
    End With

    ' Copy and timestamp
    Dim wsYearlyStock As Worksheet: Set wsYearlyStock = ThisWorkbook.Worksheets("YearlyStock")   ' define source sheet
    Dim wsTimeStamp As Worksheet: Set wsTimeStamp = ThisWorkbook.Worksheets("TimeStamp")         ' define destination sheet
    Dim YearlyStockRow As Long: YearlyStockRow = ActiveCell.Row                                  ' get current row in YearlyStock
    Dim DestRow     As Long: DestRow = FindDestRow(wsYearlyStock, wsTimeStamp, YearlyStockRow)

    If DestRow > 0 Then

        ' Update existing row if the date matches
        If wsTimeStamp.Cells(DestRow, "A").Value = Date Then
            wsTimeStamp.Cells(DestRow, "C").Value = wsTimeStamp.Cells(DestRow, "C").Value + balanceStock
        Else

            ' Add new row
            AddNewTimeStampRow wsTimeStamp, YearlyStockRow, balanceStock
        End If

    Else

        ' Add new row if no matching row is found
        AddNewTimeStampRow wsTimeStamp, YearlyStockRow, balanceStock
    End If

End Sub

Function FindDestRow(wsYearlyStock As Worksheet, wsTimeStamp As Worksheet, YearlyStockRow As Long) As Long
    Dim i           As Long

    ' Search for the matching row in TimeStamp sheet
    For i = 2 To wsTimeStamp.Cells(wsTimeStamp.Rows.Count, "B").End(xlUp).Row

        If wsTimeStamp.Cells(i, "B").Value = wsYearlyStock.Cells(YearlyStockRow, "C").Value Then
            FindDestRow = i
            Exit Function
        End If

    Next i

    ' Return 0 if no matching row is found
    FindDestRow = 0
End Function

Sub AddNewTimeStampRow(wsTimeStamp As Worksheet, YearlyStockRow As Long, balanceStock As Double)
    Dim NewRow      As Long: NewRow = wsTimeStamp.Cells(wsTimeStamp.Rows.Count, "A").End(xlUp).Row + 1

    ' Add new row with today's date, YearlyStock reference, and balanceStock
    With wsTimeStamp
        .Cells(NewRow, "A").Value = Date
        .Cells(NewRow, "B").Value = ThisWorkbook.Worksheets("YearlyStock").Cells(YearlyStockRow, "C").Value
        .Cells(NewRow, "C").Value = balanceStock
    End With

End Sub

Perhaps I misunderstood something. Good luck.

 

[maiwarits]

Hello @maiwarits. If I understand you correctly, here is an option:

Option Explicit

Sub addStock()

    ' Check input Applies columns E & F only
    If ActiveCell.Column < 5 Or ActiveCell.Column > 6 Then Exit Sub

    ' Find current month
    Dim Col         As Long: Col = 2 * Month(Now) + 6
    Dim balanceStock As Double: balanceStock = InputBox("Amount?")

    With ActiveCell
        .Value = .Value + balanceStock
        If balanceStock < 0 Then Col = Col + 1
        Cells(.Row, Col) = Cells(.Row, Col) + balanceStock
    End With

    ' Copy and timestamp
    Dim wsYearlyStock As Worksheet: Set wsYearlyStock = ThisWorkbook.Worksheets("YearlyStock")   ' define source sheet
    Dim wsTimeStamp As Worksheet: Set wsTimeStamp = ThisWorkbook.Worksheets("TimeStamp")         ' define destination sheet
    Dim YearlyStockRow As Long: YearlyStockRow = ActiveCell.Row                                  ' get current row in YearlyStock
    Dim DestRow     As Long: DestRow = FindDestRow(wsYearlyStock, wsTimeStamp, YearlyStockRow)

    If DestRow > 0 Then

        ' Update existing row if the date matches
        If wsTimeStamp.Cells(DestRow, "A").Value = Date Then
            wsTimeStamp.Cells(DestRow, "C").Value = wsTimeStamp.Cells(DestRow, "C").Value + balanceStock
        Else

            ' Add new row
            AddNewTimeStampRow wsTimeStamp, YearlyStockRow, balanceStock
        End If

    Else

        ' Add new row if no matching row is found
        AddNewTimeStampRow wsTimeStamp, YearlyStockRow, balanceStock
    End If

End Sub

Function FindDestRow(wsYearlyStock As Worksheet, wsTimeStamp As Worksheet, YearlyStockRow As Long) As Long
    Dim i           As Long

    ' Search for the matching row in TimeStamp sheet
    For i = 2 To wsTimeStamp.Cells(wsTimeStamp.Rows.Count, "B").End(xlUp).Row

        If wsTimeStamp.Cells(i, "B").Value = wsYearlyStock.Cells(YearlyStockRow, "C").Value Then
            FindDestRow = i
            Exit Function
        End If

    Next i

    ' Return 0 if no matching row is found
    FindDestRow = 0
End Function

Sub AddNewTimeStampRow(wsTimeStamp As Worksheet, YearlyStockRow As Long, balanceStock As Double)
    Dim NewRow      As Long: NewRow = wsTimeStamp.Cells(wsTimeStamp.Rows.Count, "A").End(xlUp).Row + 1

    ' Add new row with today's date, YearlyStock reference, and balanceStock
    With wsTimeStamp
        .Cells(NewRow, "A").Value = Date
        .Cells(NewRow, "B").Value = ThisWorkbook.Worksheets("YearlyStock").Cells(YearlyStockRow, "C").Value
        .Cells(NewRow, "C").Value = balanceStock
    End With

End Sub

Perhaps I misunderstood something. Good luck.

Dear MikeVol,

Hello sir!
Sorry for my late reply.

I just clear my work and continue for this project again.


the value in timestamp sheet always combines for 1Gas name.
But actually, I would like to create time stamp in every event not combine total value for 1

Example:
Gas name1
I add 5 to stock, I would like to create 1 time stamp in new row.
Also, If I use 1, I would like to create 1 time stamp in new row. ( not combine in the same row)

I appreciate for your help in advance!

Thanks,
Warit L.