• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 302
  • Last Modified:

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

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 :)!


  • 7
  • 5
1 Solution
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.

SuraDalbinAccountantAuthor Commented:
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.
SuraDalbinAccountantAuthor Commented:
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.
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

You want to do this for all accounts that are used in TB Import?
SuraDalbinAccountantAuthor Commented:
Yes, all accounts that are duplicates.
What is your definition of "duplicates"?
SuraDalbinAccountantAuthor Commented:
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.
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!

SuraDalbinAccountantAuthor Commented:
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.
SuraDalbinAccountantAuthor Commented:
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!
SuraDalbinAccountantAuthor Commented:

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
Thanks for your kind words.  It was fun :)

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 7
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now