Excel VBA Code: Read-out, count and compare values with output in another sheet.

Hey Guys! I need your help.

I'm working on my Equipment list and I was hoping to make it a bit more efficient (for now with formulas).
I have my Data sheet where I want to input my data. And on a second sheet, it is counting, depending on the project documents,
the Quantities of my Tools which I have checked-out or used there yet. (In the end I wanna create some charts and diagrams to post later, but that's really not a big problem now.)

I was looking around to see if I find some VBA Macro Code and tried to Code myself (for some time already), but I got nowhere and a PivotTable is what I want to avoid.

Maybe one of the master programmers here can help me out please? :-) (Excel Sheet attached)
It would help me a lot.

11111.JPG
22222.JPG

Hi there,

Will the same document Number (e.g. "Doc-45") ever appear in the "Word Doc Number" column AND the "Excel Doc Number" column?

Regards,

Greg M

Hi there,

I'm assuming that the answer to my question above is "NO"

Take a look at the attached version of your workbook and see if it does what you need.

Adding or editing an "Excel Doc Number" or "Word Doc Number" value on your "Data" worksheet will (if appropriate) add a new row to the Table on your "Output" worksheet, and the new row will be populated with the required formulas.

The code assumes that all document numbers will have the format "Doc-##" or "Doc-###".

The workbook uses the following code in a standard VBA CodeModule:

Option Explicit


'=========================================================================================
'=========================================================================================
'           PUBLIC ROUTINES
'=========================================================================================
'=========================================================================================


Public Sub ProcessChangedValueIfAppropriate(rTarget As Range)

    If mbSingleCellChanged(rTarget:=rTarget) = True Then

        If mbDocumentNoCellChanged(rTarget:=rTarget) = True Then

            If mbDocumentNoIsValid(rTarget:=rTarget) = True Then

                If mbDocumentNoIsAlreadyListed(rTarget:=rTarget) = False Then

                    Call AddNewDocumentNo(rTarget:=rTarget)
                    Call SortDocumentNos

                End If

            End If

        End If

    End If

End Sub


'=========================================================================================
'=========================================================================================
'           PRIVATE ROUTINES
'=========================================================================================
'=========================================================================================


Private Sub AddNewDocumentNo(rTarget As Range)

    Dim rNewDocumentNoCell  As Range
    Dim rDocumentNoColumn   As Range
    Dim lobOutput           As ListObject
    Dim rNewRow             As Range

    Set lobOutput = mlobOutput()

    lobOutput.ListRows.Add

'   The Document No Column must be specified AFTER the new row has been added to the Table
    Set rDocumentNoColumn = mrDocumentNos_Output()

    With lobOutput.DataBodyRange
        Set rNewRow = .Rows(.Rows.Count)
    End With

    Set rNewDocumentNoCell = Intersect(rNewRow, rDocumentNoColumn)

    rNewDocumentNoCell.Value = rTarget.Value

    MsgBox "Document No """ & rTarget.Value & """ added to Output table", _
            vbInformation, " Document no added"

End Sub


'=========================================================================================
'=========================================================================================


Private Sub SortDocumentNos()

    Dim rDocumentNos As Range

    Set rDocumentNos = mrDocumentNos_Output()

    With rDocumentNos
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
    End With

End Sub


'=========================================================================================
'=========================================================================================
'           PRIVATE FUNCTIONS
'=========================================================================================
'=========================================================================================


Private Function mbSingleCellChanged(rTarget As Range) As Boolean

    Dim bSingleCellChanged As Boolean

    If rTarget.Cells.CountLarge = 1 Then
          bSingleCellChanged = True
    Else: bSingleCellChanged = False
    End If

    mbSingleCellChanged = bSingleCellChanged

End Function


'=========================================================================================
'=========================================================================================


Private Function mbDocumentNoCellChanged(rTarget As Range) As Boolean

    Dim bDocumentNoCellChanged  As Boolean
    Dim rDocumentNoCells_Excel  As Range
    Dim rDocumentNoCells_Word   As Range
    Dim rDocumentNoCells        As Range
    Dim wksSource               As Worksheet
    Dim lobData                 As ListObject

    If rTarget.Cells.CountLarge = 1 Then

        Set wksSource = rTarget.Parent

        Set lobData = wksSource.ListObjects("tblData")

        With lobData
            Set rDocumentNoCells_Excel = .ListColumns("Excel Doc Number").DataBodyRange
            Set rDocumentNoCells_Word = .ListColumns("Word Doc Number").DataBodyRange
        End With

        Set rDocumentNoCells = Union(rDocumentNoCells_Excel, rDocumentNoCells_Word)

        If Not Intersect(rTarget, rDocumentNoCells) Is Nothing Then
              bDocumentNoCellChanged = True
        Else: bDocumentNoCellChanged = False
        End If

    End If

    mbDocumentNoCellChanged = bDocumentNoCellChanged

End Function


'=========================================================================================
'=========================================================================================


Private Function mbDocumentNoIsValid(rTarget As Range) As Boolean

    Const sPATTERN_1        As String = "Doc-###"
    Const sPATTERN_2        As String = "Doc-##"

    Dim bDocumentNoIsValid  As Boolean
    Dim sDocumentNo         As String

    sDocumentNo = rTarget.Value

    If sDocumentNo Like sPATTERN_1 Or _
       sDocumentNo Like sPATTERN_2 Then

          bDocumentNoIsValid = True

    Else: bDocumentNoIsValid = False

    End If

    mbDocumentNoIsValid = bDocumentNoIsValid

End Function


'=========================================================================================
'=========================================================================================


Private Function mlobOutput() As ListObject

    Set mlobOutput = wksOutput.ListObjects("tblOutput")

End Function


'=========================================================================================
'=========================================================================================


Private Function mrDocumentNos_Output() As Range

    Const sDOCUMENT_NO  As String = "Doc Nmbr"

    Dim lobOutput       As ListObject

    Set lobOutput = mlobOutput()

    Set mrDocumentNos_Output = lobOutput.ListColumns(sDOCUMENT_NO).DataBodyRange

End Function



'=========================================================================================
'=========================================================================================


Private Function mbDocumentNoIsAlreadyListed(rTarget As Range) As Boolean

    Dim bAlreadyListed  As Boolean
    Dim rDocumentNos    As Range
    Dim sDocumentNo     As String
    Dim lobOutput       As ListObject
    Dim rCell           As Range

    Set lobOutput = mlobOutput()

    Set rDocumentNos = mrDocumentNos_Output()

    sDocumentNo = Trim(rTarget.Value)

    bAlreadyListed = False

    For Each rCell In rDocumentNos.Cells

        If rCell.Value = sDocumentNo Then
            bAlreadyListed = True
            Exit For
        End If

    Next rCell

    mbDocumentNoIsAlreadyListed = bAlreadyListed

End Function

and the following code in the VBA CodeModule of the "Data" worksheet:

Option Explicit


'=========================================================================================
'=========================================================================================


Private Sub Worksheet_Change(ByVal Target As Range)

    Call ProcessChangedValueIfAppropriate(rTarget:=Target)

End Sub

Hope this helps - please let me know how you get on.

Regards,

Greg M