vba for linking to cells, and listing them in separate worksheet if duplicate

Posted on 2011-02-19
Last Modified: 2012-05-11
Hi Dave and Other Experts,

As I previously stated, the code you provided before works like a charm.  I've been testing it with no problems.  Thanks again.

Since we already have a function that tests for duplicates and populates a formula that adds and subtracts the corresponding amounts in a specified cell, is it possible to also list each account name and amount individually in separate cells.  See Balance Sheet (H), the Groupings Section, highlighted in yellow, I manually created.

Thanks for your help :)!


Question by:SuraDalbin
  • 7
  • 5
LVL 41

Expert Comment

ID: 34935021
Write a little bit about the behavior that happens first, and what is generated in yellow.  Is this static, or built with a macro?  what prompts it to be built?  Tell me a story on this so I can better undersatnd.


Author Comment

ID: 34935110
Hey Dave,

In my example, I assigned a description of "Asset:Cash" to entries G8, G9, G10, and the net of these three entries is $250, which is in fact reflected in Balance Sheet (H) D6, as a formula.  I would also like the code to list the three description cells from TB Import (A) B8, B9, B10 in Balance Sheet (H) B41, B42, B43 and their corresponding amounts from TB Import (A) C8, C9 and E10(as this was a credit entry) in Balance Sheet (H) D41, D42, D43(as negative).

Now, in this case, because the description I assigned was "Asset:Cash", the code looks in the Descriptions worksheet for the cell address to paste any amounts and it finds that the amounts belongs in D6 Balance Sheet (H).  Now, can this second step that I'd like it to do also link (or copy and paste) the information above and its corresponding worksheet?

Thanks for your help.

Author Comment

ID: 34935117
As soon as there is a duplicate description in TB Import (A), in addition to populating a cell with a formula of all the cell addresses in one cell.  The entries  that add up or net to the total should be linked (or copied and pasted) in their corresponding worksheet, whose address is in the Descriptions worksheet.
LVL 41

Expert Comment

ID: 34935168
You want to do this for all accounts that are used in TB Import?

Author Comment

ID: 34935256
Yes, all accounts that are duplicates.
LVL 41

Expert Comment

ID: 34935346
What is your definition of "duplicates"?
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline


Author Comment

ID: 34935396
Well in the example i gave you before, there were three entries to which i had assigned asset:cash, so i would like to see the three accounts that make up this total.
LVL 41

Accepted Solution

dlmille earned 500 total points
ID: 34935495
Ok.  I usurped the double-click event.  Just double-click on any of the values in Column D for Assets on the Balance Sheet.  It will generate the table, below.

It first collects all Accounts associated with the Asset that have non-zero credit or debit.  After the array is built, it generates that report, below, summing debit - credit and puts totals.

Here's where I trapped the double click - in the CODEPAGE for the Balance Sheet

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Cancel = True
    Application.EnableEvents = False
    Call ShowGrouping(Target.Offset(0, -2))
    Application.EnableEvents = True
End Sub

Open in new window

Here's the code that makes it work

Type AccountValues
    Acct As String
    AcctDebit As Double
    AcctCredit As Double
End Type
Public Sub ShowGrouping(myAsset As Range)
Const myTBImport As String = "TB Import (A)"
Const descrCol As String = "G"
Const debitCol As String = "C"
Const creditCol As String = "E"
Dim myCell As Range, i As Integer, iLast As Integer
Dim myAcctValues(100) As AccountValues
Dim mySheet As String, rOutCursor As Range

    mySheet = "'" & myTBImport & "'!"
    Set rOutCursor = Range("B41") ' initial output range
'create Header and format
    With Range("A39:D40").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Range("A39:D39").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Range("A39")
        .value = "Groupings - " & myAsset.value
        .Font.Bold = True
    End With
'Pull all related Asset accounts into Array myAcctValues()
    i = 0
    For Each myCell In Sheets(myTBImport).Range(Range(mySheet & descrCol & "7").Address, Range(mySheet & descrCol & "65535").End(xlUp).Address)
        If myCell.value = "Asset:" & cleanUp(myAsset.value) And Not (myCell.Offset(0, -4).value = 0 And myCell.Offset(0, -2).value = 0) Then
            myAcctValues(i).Acct = myCell.Offset(0, -5).value
            myAcctValues(i).AcctDebit = myCell.Offset(0, -4).value
            myAcctValues(i).AcctCredit = myCell.Offset(0, -2).value
            i = i + 1
        End If
    Next myCell
    iLast = i - 1

'Now display the accounts at the bottom
    For i = 0 To iLast
        rOutCursor.value = myAcctValues(i).Acct
        rOutCursor.Offset(0, 2).value = myAcctValues(i).AcctDebit - myAcctValues(i).AcctCredit

        Range(Cells(rOutCursor.Row, 1), Cells(rOutCursor.Row, 4)).PasteSpecial xlPasteFormats
        rOutCursor.Offset(0, 2).Style = "Comma"
        Set rOutCursor = rOutCursor.Offset(1, 0)
    Next i
End Sub
Function cleanUp(str As String) As String
Dim findColon As Integer
    If str = "Less:  Allowance for Bad Debts" Then
        cleanUp = "Allowance for Bad Debts"
        cleanUp = str
    End If
End Function

Open in new window

Hope this is what you're looking for!


Author Comment

ID: 34935543
Im not home right now, but i will check it as soon as i have access to a pc. Thanks a lot for your help, have a good one.

Author Closing Comment

ID: 34939247
Dave's instructions and code are easy to follow and he provides explanation and rationale for the use of any code he provides. Excellent! Excellent! Excellent!

Author Comment

ID: 34939258

Thanks a million Dave.  This is way better than what I had envisioned the code to do for the Reviewers.  Thanks for taking the time and most importantly for asking for narratives, as with this you were able to provide a better solution.


David Sura
LVL 41

Expert Comment

ID: 34939270
Thanks for your kind words.  It was fun :)


Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (, it was inspired by an email posting I made to EUSPRIG (, I will briefly cover: 1) An overvie…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now