Transaction to Inventory excel VBA using macro

​Hello guys!

I want to write a macro to receive data from the 'Transaction' sheet and gives me an 'Inventory' sheet but I don't know how to do it

(the 'Transaction' sheet may contain many shares so the macro should count them all and if we sell a share that we don't have in the first place,(short it) it should warn us)

could you please help me??

Hi mohi021,

Welcome to the forum.

I'm sure about "if we sell a share that we don't have in the first place,(short it) it should warn us" but this will do everything else:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long, lngMyRow As Long
    Dim wsTrans As Worksheet, wsInventory As Worksheet
    Dim clnTickers As New Collection
    Dim varTicker As Variant
    
    Application.ScreenUpdating = False
    
    Set wsTrans = ThisWorkbook.Sheets("Transaction")
    lngLastRow = wsTrans.Cells(Rows.Count, "A").End(xlUp).Row
    
    'Create unique list of ticker codes
    On Error Resume Next
        wsTrans.ShowAllData
        For lngMyRow = 2 To lngLastRow
            clnTickers.Add wsTrans.Range("A" & lngMyRow), CStr(wsTrans.Range("A" & lngMyRow))
        Next lngMyRow
    On Error GoTo 0
    
    'Clear existing contents and output unique ticker codes with associated formulas
    Set wsInventory = ThisWorkbook.Sheets("Inventory")
    lngLastRow = wsInventory.Range("A:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    wsInventory.Range("A2:I" & lngLastRow).ClearContents
    lngMyRow = 2
    For Each varTicker In clnTickers
        wsInventory.Range("A" & lngMyRow).Value = varTicker
        wsInventory.Range("B" & lngMyRow).Formula = "=IFERROR(SUMIFS('" & wsTrans.Name & "'!C:C,'" & wsTrans.Name & "'!B:B,""Buy"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("C" & lngMyRow).Formula = "=IFERROR(B" & lngMyRow & "*D" & lngMyRow & ",0)"
        wsInventory.Range("D" & lngMyRow).Formula = "=IFERROR(AVERAGEIFS('" & wsTrans.Name & "'!D:D,'" & wsTrans.Name & "'!B:B,""Buy"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("E" & lngMyRow).Formula = "=IFERROR(SUMIFS('" & wsTrans.Name & "'!C:C,'" & wsTrans.Name & "'!B:B,""Sell"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("F" & lngMyRow).Formula = "=IFERROR(E" & lngMyRow & "*G" & lngMyRow & ",0)"
        wsInventory.Range("G" & lngMyRow).Formula = "=IFERROR(AVERAGEIFS('" & wsTrans.Name & "'!D:D,'" & wsTrans.Name & "'!B:B,""Sell"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("H" & lngMyRow).Formula = "=IFERROR(B" & lngMyRow & "-E" & lngMyRow & ",0)"
        wsInventory.Range("I" & lngMyRow).Formula = "=IFERROR(E" & lngMyRow & "*(G" & lngMyRow & "-D" & lngMyRow & "),0)"
        lngMyRow = lngMyRow + 1
    Next varTicker
    
    'Total Cost formula
    lngLastRow = wsInventory.Cells(Rows.Count, "C").End(xlUp).Row
    wsInventory.Range("C" & lngLastRow + 2).Formula = "=IFERROR(SUM(C2:C" & lngLastRow & "),0)"
    
    Application.ScreenUpdating = True
    
    MsgBox "Inventory data has now been prepared.", vbInformation

End Sub

Regards,

Robert

Hi mohi021,

you are a true savior!!

Hardly. Just another Excel user

1 - The code clears and reimports the data to the Inventory tab so you don't have to do that manually. The revised code does however only delete from Row 2 onwards.
2 - No, it shouldn't matter. You will have to test that yourself though.

Thanks,

Robert

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long, lngMyRow As Long
    Dim wsTrans As Worksheet, wsInventory As Worksheet
    Dim clnTickers As New Collection
    Dim varTicker As Variant
    
    Application.ScreenUpdating = False
    
    Set wsTrans = ThisWorkbook.Sheets("Transaction")
    lngLastRow = wsTrans.Cells(Rows.Count, "A").End(xlUp).Row
    
    'Create unique list of ticker codes
    On Error Resume Next
        wsTrans.ShowAllData
        For lngMyRow = 2 To lngLastRow
            clnTickers.Add wsTrans.Range("A" & lngMyRow), CStr(wsTrans.Range("A" & lngMyRow))
        Next lngMyRow
    On Error GoTo 0
    
    'Clear existing contents (only if there's data from Row 2 onwards) and output unique ticker codes with associated formulas
    Set wsInventory = ThisWorkbook.Sheets("Inventory")
    On Error Resume Next
        lngLastRow = wsInventory.Range("A:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngLastRow >= 2 Then
            wsInventory.Range("A2:I" & lngLastRow).ClearContents
        End If
    On Error GoTo 0
    lngMyRow = 2
    For Each varTicker In clnTickers
        wsInventory.Range("A" & lngMyRow).Value = varTicker
        wsInventory.Range("B" & lngMyRow).Formula = "=IFERROR(SUMIFS('" & wsTrans.Name & "'!C:C,'" & wsTrans.Name & "'!B:B,""Buy"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("C" & lngMyRow).Formula = "=IFERROR(B" & lngMyRow & "*D" & lngMyRow & ",0)"
        wsInventory.Range("D" & lngMyRow).Formula = "=IFERROR(AVERAGEIFS('" & wsTrans.Name & "'!D:D,'" & wsTrans.Name & "'!B:B,""Buy"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("E" & lngMyRow).Formula = "=IFERROR(SUMIFS('" & wsTrans.Name & "'!C:C,'" & wsTrans.Name & "'!B:B,""Sell"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("F" & lngMyRow).Formula = "=IFERROR(E" & lngMyRow & "*G" & lngMyRow & ",0)"
        wsInventory.Range("G" & lngMyRow).Formula = "=IFERROR(AVERAGEIFS('" & wsTrans.Name & "'!D:D,'" & wsTrans.Name & "'!B:B,""Sell"",'" & wsTrans.Name & "'!A:A,A" & lngMyRow & "),0)"
        wsInventory.Range("H" & lngMyRow).Formula = "=IFERROR(B" & lngMyRow & "-E" & lngMyRow & ",0)"
        wsInventory.Range("I" & lngMyRow).Formula = "=IFERROR(E" & lngMyRow & "*(G" & lngMyRow & "-D" & lngMyRow & "),0)"
        lngMyRow = lngMyRow + 1
    Next varTicker
    
    'Total Cost formula
    lngLastRow = wsInventory.Cells(Rows.Count, "C").End(xlUp).Row
    wsInventory.Range("C" & lngLastRow + 2).Formula = "=IFERROR(SUM(C2:C" & lngLastRow & "),0)"
    
    Application.ScreenUpdating = True
    
    MsgBox "Inventory data has now been prepared.", vbInformation

End Sub