Nested if copying in to various tables

[Falcons88]

Hi
I have an input screen (input sheet) where I enter data, I then click a "add" button and based on the wording in cell F it copys data A6:D6 to the correct table on a different sheet ("chart of accounts") using the next available row in the table.
I've managed to get to work with one criteria using the word "cash", to go into a table on a different worksheet also called "cash", I'm needing to do it for multiple words such as "Bank" to go in to a table called "Bank" on chart of accounts sheet.
Below is the code I have so far, thank you in advance:

For Each cell In Sheets("Input Sheet").Range("F:F")

If cell.Value = "Cash" Then

Dim config, itm, arr

Dim rw As Range, listCols As ListColumns

Set shtForm = Worksheets("Input Sheet") '<< data source

With Sheets("Chart of Accounts").ListObjects("Table2")

Set rw = .ListRows.Add.Range 'add a new row and get its Range

Set listCols = .ListColumns 'get the columns collection

End With

config = Array("Date<>A6", "Company<>B6", "Reference<>C6", "Amount<>D6")



'loop over each item in the config array and transfer the value to the

' appropriate column

For Each itm In config

arr = Split(itm, "<>") ' split to colname and cell address

rw.Cells(listCols(arr(0)).Index).Value = shtForm.Range(arr(1)).Value

Next itm



End If

Next

End Sub

 

[JackDanIce]

Welcome to the board.

This is untested, if it doesn't work, can you show examples of the Chart of Accounts and the Input Sheet and what it should look like before and after?

Sub Transfer_Data()

    Dim x As Long
    Dim v As Variant
    Dim config As Variant: config = Array("Date<>A6", "Company<>B6", "Reference<>C6", "Amount<>D6")
    
    With Sheets("Input Sheet")
        v = .Cells(1, 6).Resize(.Cells(.Rows.Count, 6).End(xlUp).Row).Value
    End With
    
    Application.ScreenUpdating = False
    
    With Sheets("Chart of Accounts")
        For x = LBound(v, 1) To UBound(v, 1)
            Select Case v(x, 1)
                Case Is = "cash": Add_Data .ListObjects(v(x, 1)), config
                Case Is = "bank": Add_Data .ListObjects(v(x, 1)), config
                Case Else: MsgBox "Table for " & v(x, 1) & " not found!", vbExclamation, "Table not Found"
            End Select
        Next x
    End With
    
    Application.ScreenUpdating = True
    
    Erase v: Erase config
    
End Sub

Private Sub Add_Data(obj As ListObject, config As Variant)
    
    Dim x As Long
    Dim arr As Variant
    
    With obj
        For x = LBound(config) To UBound(config)
            arr = Split(config(x), "<>")
            .ListRows.Add.Range.Cells(.ListColumns(arr(0)).Index).Value = shtForm.Range(arr(1)).Value
        Next x
    End With
    
    Erase arr
    
End Sub

 

[Falcons88]

Welcome to the board.

This is untested, if it doesn't work, can you show examples of the Chart of Accounts and the Input Sheet and what it should look like before and after?

Sub Transfer_Data()

    Dim x As Long
    Dim v As Variant
    Dim config As Variant: config = Array("Date<>A6", "Company<>B6", "Reference<>C6", "Amount<>D6")
   
    With Sheets("Input Sheet")
        v = .Cells(1, 6).Resize(.Cells(.Rows.Count, 6).End(xlUp).Row).Value
    End With
   
    Application.ScreenUpdating = False
   
    With Sheets("Chart of Accounts")
        For x = LBound(v, 1) To UBound(v, 1)
            Select Case v(x, 1)
                Case Is = "cash": Add_Data .ListObjects(v(x, 1)), config
                Case Is = "bank": Add_Data .ListObjects(v(x, 1)), config
                Case Else: MsgBox "Table for " & v(x, 1) & " not found!", vbExclamation, "Table not Found"
            End Select
        Next x
    End With
   
    Application.ScreenUpdating = True
   
    Erase v: Erase config
   
End Sub

Private Sub Add_Data(obj As ListObject, config As Variant)
   
    Dim x As Long
    Dim arr As Variant
   
    With obj
        For x = LBound(config) To UBound(config)
            arr = Split(config(x), "<>")
            .ListRows.Add.Range.Cells(.ListColumns(arr(0)).Index).Value = shtForm.Range(arr(1)).Value
        Next x
    End With
   
    Erase arr
   
End Sub

Hi JackDanIce,

Thank you for you help on this, the code didn't work, it was stating it couldn't find the various tables then run-time error '424'.
Below are screen shots of input sheet and chart of accounts sheet, I have also added a screen shot of how it looks after the current code in place has run, which is fine I just need it to run for more than one criteria in the Sub Account (F6) of the input sheet, such as "Bank" to go into a table called "Bank" on the chart of accounts sheet.

 

[JackDanIce]

Without a copy of your workbook or setup, I can't test further I'm afraid.

I mocked up tables created a CoA and Input sheet and tried from there which seemed to achieve what was asked, based on the description given

Looking at your screenshots, I think using Power Query will be a better approach and reduce the amount of VBA needed

 

[Falcons88]

Without a copy of your workbook or setup, I can't test further I'm afraid.

I mocked up tables created a CoA and Input sheet and tried from there which seemed to achieve what was asked, based on the description given

Looking at your screenshots, I think using Power Query will be a better approach and reduce the amount of VBA needed

Thank you for trying, I'm unable to upload the spreadsheet as it's on a work computer and don't have access to Power Query.
Essentially I just need it to work a bit Iike a Vlookup where it checks wording in cell F of input sheet and copies A6,B6,C6,D6 of input sheet to the next blank row of the relevant table in Chart of Accounts sheet, the tables could just be table1, table2 etc the simplest way to do it would be a massive help