Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


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

Posted on 2011-02-19
Medium Priority
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
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 5
LVL 42

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.

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

LVL 42

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 42

Expert Comment

ID: 34935346
What is your definition of "duplicates"?

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 42

Accepted Solution

dlmille earned 2000 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 42

Expert Comment

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


Featured Post


Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

636 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