Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I am including a rather lenghty piece of code that almost works. I
have two sheets, "Trial Balance" and "Import". Periodically, I receive a trial balance that I place in the Import sheet with three columns: account number, account description, and balance. I include these headers at A1, B1, and C1. The data begins at A2. The Trial Balance sheet has the same three columns plus a 4th column that shows the prior period balance in column D. What I want to do is bump these two sheets together to determine if there are any new items in the Import sheet that are not in the Trial Balance sheet then add them. The way I am trying to accomplish this is to first compare the Trial Balance sheet to the Import sheet. For items that are in the Trial Balance sheet but not the Import sheet, those items are added. Then I do the opposite. Then I copy the balance column in Trial Balance to the prior year balance column then copy the balance column from the Import sheet to the balance column in the Trial Balance sheet. Along the way, I collect the items that are in the Import sheet but not the Trial Balance sheet and then put them into a "New Account" sheet for reference purposes. The catch is that since I am referencing cells in the Trial Balance balance column with formulas from other sheets, simply tacking the new items on to the end and sorting doesn't do the trick, so I have included code to insert the new items into the proper places with the account coumn sorted (so 2 would be properly placed in between 1 and 3 rather than placing it at the end and resorting). I hope that explains it. Here's the code (which was written with much help from the NG - much thanks!): Sub Import_Chart() Dim c As Integer 'Placeholder for loops. Dim x As Integer 'Placeholder for loops. Dim y As Integer 'Placeholder for loops. Dim sh As Object 'Placeholder to loop through worksheets. Dim iOldAccount As Variant 'Holds each account number for prior year (Trial Balance) 'to compare to current year (Import) account list. Dim iNewAccount As Variant 'Holds each account number for current year (Import) 'to compare to prior year (Trial Balance) account list. Dim NewAccountNumber() As String 'Array to hold the account number for any new accounts found. Dim NewAccountName() As String 'Array to hold the account name for any new accounts found. Dim NewAccountBalance() As Double Dim NewAccountSheetExists As Worksheet 'Used to check if NewAccounts worksheet exists. Application.ScreenUpdating = False 'Runs code to determine if there are any duplicate account numbers in the current year '(Import) account list. Load Duplicates_Form Unload Duplicates_Form 'Loop compares each account number in the Trial Balance chart and compares to the Import 'chart. If Import account is not found in Trial Balance chart then account is added 'to Trial Balance. Worksheets("Trial Balance").Activate c = 2 While Worksheets("Import").Cells(c, 1) < "" iOldAccount = Application.VLookup(Worksheets("Import").Cells(c, 1), Worksheets _ ("Trial Balance").Range(Cells(1, 1), Range("A1").End(xlDown)), 1, False) If IsError(iOldAccount) Then With Worksheets("Trial Balance") .Range(.Cells(c, 1), .Cells(c, 4)).Insert Shift:=xlDown End With With Sheets("Import") .Range(.Cells(c, 1), .Cells(c, 2)).Copy End With With Worksheets("Trial Balance") .Range(.Cells(c, 1), .Cells(c, 2)).PasteSpecial .Cells(c, 3).Value = 0 End With ReDim Preserve NewAccountNumber(x), NewAccountName(x), NewAccountBalance(x) NewAccountNumber(x) = Worksheets("Import").Cells(c, 1) NewAccountName(x) = Worksheets("Import").Cells(c, 2) NewAccountBalance(x) = Worksheets("Import").Cells(c, 3) x = x + 1 End If c = c + 1 Wend 'Loop compares each account number in the Import chart and compares to the Trial 'Balance chart. If Trial Balance account is not found in Import chart then 'account is added to Import account list. Worksheets("Import").Activate c = 2 While Worksheets("Trial Balance").Cells(c, 1) < "" iOldAccount = Application.VLookup(Worksheets("Trial Balance").Cells(c, 1), Worksheets _ ("Import").Range(Cells(1, 1), Range("A1").End(xlDown)), 1, False) If IsError(iOldAccount) Then With Worksheets("Import") .Range(.Cells(c, 1), .Cells(c, 3)).Insert Shift:=xlDown End With With Sheets("Trial Balance") .Range(.Cells(c, 1), .Cells(c, 2)).Copy End With With Worksheets("Import") .Range(.Cells(c, 1), .Cells(c, 2)).PasteSpecial .Cells(c, 3).Value = 0 End With End If c = c + 1 Wend Worksheets("Trial Balance").Activate With Sheets("Trial Balance") .Range("C:C").Copy .Range("D:D").PasteSpecial End With Worksheets("Import").Activate With Sheets("Import") .Range("C:C").Copy .Range("A1").Activate End With Worksheets("Trial Balance").Activate With Sheets("Trial Balance") .Range("C:C").PasteSpecial .Range("A1").Value = "Acct. #" .Range("B1").Value = "Description" .Range("C1").Value = Month(.Range("D1").Value) & "/" & Day(.Range("D1").Value) & "/" & Year(.Range("D1").Value) + 1 .Range("A1").Activate End With 'Lists all new accounts captured in the compare process in a New Accounts 'sheet. On Error Resume Next Set NewAccountSheetExists = ThisWorkbook.Worksheets("New Accounts") If x 0 Then On Error GoTo 0 If NewAccountSheetExists Is Nothing Then Set NewAccountSheetExists = Worksheets.Add(After:=Worksheets("Trial Balance")) NewAccountSheetExists.Name = "New Accounts" Range("A1").Value = "Account Number" Range("B1").Value = "Account Description" Range("C1").Value = "Balance" x = x - 1 Worksheets("New Accounts").Activate Worksheets("New Accounts").Range("A2:IV65536").ClearContents For y = 0 To x Cells(y + 2, 1).Value = NewAccountNumber(y) Cells(y + 2, 2).Value = NewAccountName(y) Cells(y + 2, 3).Value = NewAccountBalance(y) Next y Columns("A:B").Select Columns("A:B").EntireColumn.AutoFit End If Else 'Delete sheet if it exists Application.DisplayAlerts = False If Not NewAccountSheetExists Is Nothing Then ThisWorkbook.Worksheets("New Accounts").Delete End If Application.DisplayAlerts = True End If For Each sh In Worksheets sh.Activate sh.Range("A1").Select Next sh Application.CutCopyMode = False Worksheets("Trial Balance").Activate Range("A1").Select Application.ScreenUpdating = True MsgBox "Import Complete." End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
line up items in column a with items in columns b, c, etc | Excel Discussion (Misc queries) | |||
Inserting Blank rows between items | Excel Discussion (Misc queries) | |||
inserting new columns | Excel Discussion (Misc queries) | |||
Inserting columns | Excel Programming | |||
Inserting items into the Paste Special Dialog box | Excel Programming |