Copy & Paste Values to worksheet, based on User's Input

[Sura]

Hi Experts,

I'm using Excel 2007 on Windows XP.

I have the following code that, a expert from Experts-Exchange provided, which takes an amount from one sheet, and based on the User's input, it populates that amount in a different worksheet in the same workbook. It populates it to an address I have defined in the "Descriptions" worksheet. The code also converts the amount to negative if this amount is in the "credit" column in my source data. Also, if the User assigns the same "Description" to multiple line items, then all these amounts are summed and only the sum is populated in its respective worksheet. If a User deletes the description, then the amounts that were previously populated in their respective worksheets are deleted as well. See snapshots:

Source Data
http://i1009.photobucket.com/albums/af214/davidsura/Excel/SourceData.jpg
Address
http://i1009.photobucket.com/albums/af214/davidsura/Excel/Address.jpg
Income Statement
http://i1009.photobucket.com/albums/af214/davidsura/Excel/WorksheetwithPopulatedAmounts.jpg

Option Explicit
Dim oLastSelectedAccountHeads As Collection


Private Sub Workbook_Open()

'Open Menu at start up
frmSwitchBoard.Show

End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim oSelectedRange As Range, oRange As Range

If Target.Worksheet.Name <> "TB Import (A)" Then Exit Sub
Set oLastSelectedAccountHeads = New Collection
Set oSelectedRange = Application.Intersect(Target, ['TB Import (A)'!G:G])
If Not oSelectedRange Is Nothing Then
    For Each oRange In oSelectedRange.Cells
        If oRange.Value <> "" Then oLastSelectedAccountHeads.Add oRange.Value
    Next
End If

End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim oChangedRange As Range, oRange As Range, bBlankFlag As Boolean

'Listen for changes in Sheet1, Column G.
If Target.Worksheet.Name <> "TB Import (A)" Then Exit Sub
Set oChangedRange = Application.Intersect(Target, ['TB Import (A)'!G:G])
'If nothing changes in "Accounts" range, do nothing, but do set the listening range for which we want to listen to
If Not oChangedRange Is Nothing Then
    bBlankFlag = False
    Set oChangedRange = Application.Range("'TB Import (A)'!G7").Resize([Accounts].Rows.Count)
    'Do for all cells in "Accounts" range
    For Each oRange In oChangedRange.Cells
        If oRange.Value <> "" Then
            RecalculateSums oRange
        Else
            bBlankFlag = True
        End If
    Next
    If bBlankFlag Then RecalculateSums_Blank
End If

End Sub


Private Sub RecalculateSums(oRange As Range)
Dim dSum As Double
Dim nRowIndex As Long

'In Sheet1 Take amount of categorized expense, and convert to negative if in column E.
'Also, if there are multiple accounts with the same category, chosen by User, Sum all amounts and populate the respective worksheet with the total.
Application.EnableEvents = False
dSum = Application.WorksheetFunction.SumIfs(['TB Import (A)'!C:C], ['TB Import (A)'!G:G], "=" & oRange.Value) - Application.WorksheetFunction.SumIfs(['TB Import (A)'!E:E], ['TB Import (A)'!G:G], "=" & oRange.Value)
nRowIndex = Application.WorksheetFunction.Match(oRange.Value, [Descriptions!A:A], 0)
'Double check that all descriptions have been mapped to an address in a respective workbook, if not display error message.  When mapped, remove error message.
If Application.Range("Descriptions!B" & nRowIndex) = "" Or Application.Range("Descriptions!C" & nRowIndex) = "" Then
    oRange.Offset(, 1).Value = "#ERROR: Linking address not specified yet!"
Else
    Application.Range("'" & Application.Range("Descriptions!B" & nRowIndex) & "'!" & Application.Range("Descriptions!C" & nRowIndex)).Value = dSum
    oRange.Offset(, 1).Value = ""
End If
Application.EnableEvents = True

End Sub


Private Sub RecalculateSums_Blank()
Dim dSum As Double, nCtr As Long
Dim nRowIndex As Long

'If multiple acccounts with same category, keep track of these totals and when scanning the Descriptions column, if more than one description has been deleted at the same time,
'delete all previously populated amounts from corresponding worksheets
Application.EnableEvents = False
For nCtr = 1 To oLastSelectedAccountHeads.Count
    dSum = Application.WorksheetFunction.SumIfs(['TB Import (A)'!C:C], ['TB Import (A)'!G:G], "=" & oLastSelectedAccountHeads(nCtr)) - Application.WorksheetFunction.SumIfs(['TB Import (A)'!E:E], ['TB Import (A)'!G:G], "=" & oLastSelectedAccountHeads(nCtr))
    nRowIndex = Application.WorksheetFunction.Match(oLastSelectedAccountHeads(nCtr), [Descriptions!A:A], 0)
    If Application.Range("Descriptions!B" & nRowIndex) = "" Or Application.Range("Descriptions!C" & nRowIndex) = "" Then
    Else
        Application.Range("'" & Application.Range("Descriptions!B" & nRowIndex) & "'!" & Application.Range("Descriptions!C" & nRowIndex)).Value = dSum
    End If
Next
Application.EnableEvents = True

End Sub

I would like to do the following:

1. In the same manner that the code traces any changes in sheet "TB Import (A)", column G, and it populates the amounts from column C or E, from that same worksheet, and that it also converts the amount to negative, if it's in column E, and that if there are multiple line items to which the User assigns the same description to it combines all amounts and populates the Summation of all.

• I would like the code to also trace column D in worksheet "AJEs (I)" and do exactly the same thing that it does for the "Description" assigned by User in sheet "TB Import (A)".
• The addresses that these amounts in the "AJEs (I)" worksheet are to be populated in are the same as what's currently in the code above, except that instead of column D, these amounts should go to Column F. These amounts basically go to a different column only, but the address is the same as those in the "TB Import (A)" worksheet go to.
• See picture: http://i1009.photobucket.com/albums/af214/davidsura/Excel/SecondSourceData.jpg

I have tried adding, to the code above, duplicate functions, if-statements, you know, just changing the columns to be traced and the respective addresses, but no luck.

I have also tried having the two columns to be traced in the same if-statement, and specified that these two columns are in two different worksheets, but again, no luck.

I truly hope you can help me with this.

Please let me know if you need anything else from me.

Thank you so much for any help on this,


David

 

[Sura]

Moderators, how can I delete this thread? Thanks.