Home » excel » Excel VBA – Assistance on comparing ranges and arrays

Excel VBA – Assistance on comparing ranges and arrays

Posted by: admin May 14, 2020 Leave a comment

Questions:

I’ve got this workbook I’ve been trying to get to work via macro code. And I’ve had some assistance with it, but nobody seems to understand what I’m after. It’s a workbook used to track and keep a summary of the amount of work clothes each user in our company has received. So, basically, I’ve got three sheets in this workbook: https://skydrive.live.com/view.aspx?cid=5D018DB0458F03ED&resid=5D018DB0458F03ED%21163

  • Summary
  • Users
  • Articles

The general idea was that I would create a PivotTable from the data in the Summary sheet. But I want the workbook to be dynamic using vba code. So I’ll go through each sheet here.

Users: This workbook contains just one column (A), A1 is called “Name” and each row under that contains each user in our Company.

Articles: This workbook contains two columns, A1 is the name of the article (pants etc) and the other one is the price of that item.

Summary: This is the tricky part. This sheet should mirror the data from the other two sheets, but I need to keep track of how many of each item each user has received as well. I keep this data in Column D in the Summary sheet. So each name in the Users sheet needs to be repeated as many times as there are items in the Articles sheet. If there are 10 items in the Article sheet, the name must be repeated 10 times. That way, I can say how many of each item that user has received.

So, the tricky part is to actually mirror the content from the Users and Articles sheet, but still keep the data from column D in the summary sheet. Also keep in mind that if I remove a row from the Users sheet then that user needs to be removed completely from the Summary Sheet, including the amount of each item that was registered. And if I add an item to the Articles sheet, then that item needs to be added for each user in the Summary sheet.

I’ve got some macro code there that somebody helped me with, but I didn’t really get what was going on. I’m not that sturdy with arrays and loops. And this is what I’m trying to learn now because I see the potential of learning it.

I do however get that I need to collect the data from all sheets in their own ranges, storing all of the data. Then I need to compare the Users range with the Summary Range to see if the user is present in that range. If it is, make sure to update the data from the Articles Range as well as keeping the amount from ColumnD. If it’s not in the Summary sheet, add it. The same goes for each item as well.

But, what if I mistype a user and don’t realize it until after I’ve been adding amounts for that user? If I then go back to the Users sheet and rename the user, would I loose all of the data I previously added? Or is it possible to be able to rename users as well? In that case, I’d probably need some sort of ID for each user, much like CID in Windows? Is this all a bit too overkill? It all comes down to what it more worth while, timewise. I’d really appreciate some help here 🙂

Public Sub NewCollect()
' Declare variables
Dim shtUsers, shtmyArticles, shtmySummary, shtmyAmount As Worksheet
Dim arrUsers, arrarticles, arramount, arrsummary As Long

' Set worksheets
Set shtUsers = Sheets("Brukere")
Set shtArticles = Sheets("Artikler")
Set shtSummary = Sheets("Oppsummering")
Set shtAmount = Sheets("Antall")

' Get range from shtUsers
With shtUsers
    If Not .Range("A2") = "" Then
        arrUsers = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    End If
End With

' Get range from shtArticles
With shtArticles
    If Not .Range("A2") = "" Then
        arrarticles = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 3)
    End If
End With

' Get range from shtAmount (The new sheet)
With shtAmount
    If Not .Range("A2") = "" Then
        arramount = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    End If
End With

' Get range from shtSummary
With shtSummary
    If Not .Range("A2") = "" Then
        'Here I have no idea where to even begin
    Else
        ' If Summary sheet is blank, get data from other sheet and insert
        ReDim tempArr(1 To UBound(arrUsers) * UBound(arrarticles), 1 To 6)
        For u = 1 To UBound(arrUsers)
            For i = 1 To UBound(arrarticles)
                j = j + 1
                tempArr(j, 1) = arrUsers(u, 1)
                tempArr(j, 2) = arrUsers(u, 2)
                tempArr(j, 3) = arrarticles(i, 1)
                tempArr(j, 4) = arrarticles(i, 2)
                tempArr(j, 6) = arrarticles(i, 3)
            Next
        Next
        ' Add the data
        .Range("A2").Resize(j, 6).Value = tempArr
    End If
End With

Edit: I just added a new column to both users and articles sheets kalled ID where I can add an ID for each item. Updated the actual sheet on my SkyDrive now.

How to&Answers:

I would first start by totally separating your input from your output. This is based on experience since I put together a rather complex accounting spreadsheet for an accountant a couple of years ago which would act as a general ledger and P&L.

Control information was on one sheet, GL codes were on another, transactions were on yet another, and a macro basically went through and created summary and detail balance sheets and income/expenditure statements on four other sheets.

The original attempt tried to manipulate information on the input side but it turned out to be a nightmare. Once the input and output were separated, it became a lot easier to manage.

In other words, have something like the following sheets:

  • People.
  • Items.
  • Transaction.
  • Output.

The first three of those are input only. The transaction are a list of what items were given to what people (a many-to-many relationship). Then I would have a macro which performs as follows.

First, clear out the fourth sheet totally (Output). Then, for each active person in the People sheet, go through the Transaction sheet and create an Output entry for any transaction attached to that person.

By the way, I say ‘active’ above since you might want to maintain the history, keeping records around for people who have left. That would be a flag of some sort in the People sheet.

You’ll probably need to look up the items and prices as part of this process.

You can report on errors as part of the macro as well, such as Transaction entries that have no valid People or Items.

You may also want to consider the possibility that some people/items may have identical names (and even an identical item may change price periodically). To that end, it might be wise to attach a unique ID to each person and item to ensure there’s no possibility of mis-identification. Those unique IDs would be stored in the Transactions sheet.


Since the macro I discussed weighs in at 37K, I can’t post the lot here. But this is the main processing bit which processes the transactions sheet and updates the accounts page with balances:

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit

Public Const TxnSheet = "Txns"
Public Const TxnColId = "a"
Public Const TxnColDate = "b"
Public Const TxnColAcct = "c"
Public Const TxnColAmt = "d"
Public Const TxnColDesc = "e"
Public Const TxnColNotes = "f"
Public Const TxnRowStart = "2"

Public Const AcctSheet = "Accts"
Public Const AcctColReport = "a"
Public Const AcctColType = "b"
Public Const AcctColBold = "c"
Public Const AcctColItalic = "d"
Public Const AcctColFontPlus1 = "e"
Public Const AcctColOther2 = "f"
Public Const AcctColOther3 = "g"
Public Const AcctColOther4 = "h"
Public Const AcctColOther5 = "i"
Public Const AcctColLevel = "j"
Public Const AcctColSign = "k"
Public Const AcctColAcct = "l"
Public Const AcctColVal = "m"
Public Const AcctColNotes = "n"
Public Const AcctRowStart = "2"

' Process all transactions.

Sub ProcessTransactions()
    Dim TxnId As Integer
    Dim Balance As Double
    Dim WsTxn As Worksheet
    Dim WsAcct As Worksheet

    Dim RowTxn As String
    Dim RowAcct As String

    Dim RowTxn2 As String
    Dim RowTxn3 As String

    Dim StartDate As Date
    Dim EndDate As Date
    Dim CutoffDate As Date
    Dim PastCutoff As Boolean

    ' Get user-configurable stuff

    StartDate = GetConfig("start_date")
    EndDate = GetConfig("end_date")
    CutoffDate = GetConfig("cutoff_date")
    PastCutoff = False

    ' For filling in transaction IDs.

    TxnId = 1

    Set WsTxn = Worksheets(TxnSheet)
    Set WsAcct = Worksheets(AcctSheet)
    RowTxn = TxnRowStart


    ' Select the worksheet and cell so we can see what's happening.

    WsTxn.Select
    Range(TxnColAcct + RowTxn).Select
    Range(TxnColAcct + RowTxn).Show

    ' Process all transaction lines.

    Do While Range(TxnColAcct + RowTxn).Value <> ""
        ' Check for start of transaction (non-blank date).

        If Range(TxnColDate + RowTxn).Value <> "" Then
            ' Check date within range.

            If Range(TxnColDate + RowTxn).Value < StartDate Or Range(TxnColDate + RowTxn).Value > EndDate Then
                Range(TxnColDate + RowTxn).Select
                MsgBox "ERROR: ProcessTransactions: Date out of range"
                End
            End If

            If Range(TxnColDate + RowTxn).Value > CutoffDate Then
                PastCutoff = True
            End If

            ' Start of transaction, fill in transaction ID and increment.

            Range(TxnColId + RowTxn).Value = TxnId
            TxnId = TxnId + 1

            ' Check that transaction is balanced.

            RowTxn2 = FindNextTxn(RowTxn)
            RowTxn3 = PrevRow(RowTxn2)

            Balance = 0
            Do While RowTxn2 <> RowTxn
                RowTxn2 = PrevRow(RowTxn2)
                Balance = Balance + Range(TxnColAmt + RowTxn2).Value
            Loop
            If Balance > 0.001 Or Balance < -0.001 Then
                Range(TxnColAmt + RowTxn + ":" + TxnColAmt + RowTxn3).Select
                MsgBox "ERROR: ProcessTransactions: Unbalanced transaction"
                End
            End If
        Else
            ' Not transaction start, clear transaction ID column.

            Range(TxnColDate + RowTxn).Clear
        End If

        ' Get account line, error if account not in accounts worksheet.

        RowAcct = FindAccount(Range(TxnColAcct + RowTxn).Value)
        If RowAcct = "" Then
            MsgBox "ERROR: ProcessTransactions: Invalid account '" & Range(TxnColAcct + RowTxn).Value & "'"
            End
        End If

        ' Update accounts value.

        If Not PastCutoff Then
            WsAcct.Range(AcctColVal + RowAcct) = WsAcct.Range(AcctColVal + RowAcct) + Range(TxnColAmt + RowTxn).Value
        End If

        ' Move to next transaction.

'        Sleep 50
        RowTxn = NextRow(RowTxn)
        Range(TxnColAcct + RowTxn).Select
        Range(TxnColAcct + RowTxn).Show
    Loop

    Range(TxnColDate + RowTxn).Select
    Range(TxnColDate + RowTxn).Show
End Sub

It may not be that useful without knowing the sheet layout but it’s the best I can do without being able to send you the whole workbook.