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
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.
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:
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.