Conditional copying from a table in Excel

Question

I'm trying to copy to both debit/credit columns to other tables which match only the respective account value i.e. all Cash entries go to a Cash Account table, etc. I'll also need a way to omit those that have already been copied (so some check column will have to be referenced).

but I'm unclear how to translate this into VBA.

Here's a visual from the worksheet:

And my VBA code so far (MyAdd being a function that copies the range to another specified table)

Sub CopyRange()
For Each c In Range("Journal").Cells
 If c.Value = "Cash" Then
    If Range("Journal[@[Account 1]]").Value = "Cash" Then MyAdd "Cash_Account", Range(c.Offset(0, 2), c.Offset(0, 3))
    Else: MyAdd "Cash_Account", Range(c.Offset(0, 1), c.Offset(0, 2))
Next
End Sub

Why not loop over the Account1 and Account2 columns, instead of the whole table? — Tim Williams, Apr 27 '20 at 18:41

score 0 · Answer 1 · answered Apr 27 '20 at 19:41

I'm not sure why you'd want to do this. It would seem there is another end goal in mind. However, to do what you're asking in VBA can be done with the below code.

Sub GetNewColumnOfData()

    Dim Table As ListObject
    Dim TargetRange As Range
    Dim Index As Long
    Dim Values As Variant

    Set Table = ThisWorkbook.Worksheets("Sheet3").ListObjects("Journal")
    Set TargetRange = ThisWorkbook.Worksheets("Sheet3").Range("G1")
    ReDim Values(1 To Table.ListRows.Count, 1 To 1)

    For Index = 1 To Table.ListRows.Count
        If Table.ListColumns("Account 1").DataBodyRange(Index, 1).Value = "Cash" Then
            Values(Index, 1) = 1
        ElseIf Table.ListColumns("Account 2").DataBodyRange(Index, 1).Value = "Cash" Then
            Values(Index, 1) = 2
        End If
    Next Index

    TargetRange.Resize(Table.ListRows.Count, 1).Value = Values

End Sub

Define your range/table names accordingly.

Yes - the goal is to copy the debit/credit columns to another table based on the entry in the account column. — Mark Slater, Apr 28 '20 at 03:37
But thank you Zack - you have shown me alternatives to loop through and reference the cells in the table - and creating an array to hold the values, before pasting. — Mark Slater, Apr 28 '20 at 03:45

score 0 · Answer 2 · answered Apr 28 '20 at 06:55

Using Zack's solution, I have created my solution this way - in case anyone wants to follow my work and improve upon it:

Sub GetNewColumnOfData()

    Dim Table As ListObject
    Dim TargetRange As Range
    Dim Index As Long
    Dim Account As String

    Set Table = Range("Journal").ListObject

    For Index = 1 To Table.ListRows.Count
        If Not IsEmpty(Table.ListColumns("Account 1").DataBodyRange(Index, 1)) And IsEmpty(Table.ListColumns("*").DataBodyRange(Index, 1)) Then
            Account = Table.ListColumns("Account 1").DataBodyRange(Index, 1).Value
            Table.ListColumns("*").DataBodyRange(Index, 1).Value = "*"
            MyAdd Account, Range(Table.ListColumns("Debit").DataBodyRange(Index, 1), Table.ListColumns("Credit").DataBodyRange(Index, 1))
        ElseIf Not IsEmpty(Table.ListColumns("Account 2").DataBodyRange(Index, 1)) And IsEmpty(Table.ListColumns("*").DataBodyRange(Index, 1)) Then
            Account = Table.ListColumns("Account 2").DataBodyRange(Index, 1).Value
            Table.ListColumns("*").DataBodyRange(Index, 1).Value = "*"
            MyAdd Account, Range(Table.ListColumns("Debit").DataBodyRange(Index, 1), Table.ListColumns("Credit").DataBodyRange(Index, 1))
        End If
    Next Index

End Sub

The MyAdd function was derived elsewhere on this site but I quote it here for ease of reference:

Sub MyAdd(ByVal strTableName As String, ByRef arrData As Variant)
    Dim tbl As ListObject
    Dim NewRow As ListRow

    Set tbl = Range(strTableName).ListObject
    Set NewRow = tbl.ListRows.Add(AlwaysInsert:=True)

    ' Handle Arrays and Ranges
    If TypeName(arrData) = "Range" Then
        NewRow.Range = arrData.Value
    Else
        NewRow.Range = arrData
    End If
End Sub

Note I put this code in a module for the Workbook - and all the Ranges (tables/lists) are by default Workbook named ranges - hence accessible without needing to specify the sheets they are on.

This will be much slower over a larger range as opposed to an array. The problem is the Table.ListRows.Add method, it's very expensive unfortunately. — Zack Barresse, Apr 28 '20 at 15:51
Yes. The array creation will be more complicated - since although there are a finite/known number of "account" names, I don't want to create dozens of IF loops and arrays - but I think a three dimensional array. I will try. — Mark Slater, May 10 '20 at 11:44

Conditional copying from a table in Excel

2 Answers2