Inserting new items into columns

[Michael Malinsky]

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").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