Automatic table detection

[mariatti]

Hi mate,
I'm making a personalized expense spreadsheet, to put salaries, fixed costs and expenses on the credit card. So, each month, I create a copy of the spreadsheet within the same Excel file. The problem is that with each copy the tables change their name and the VBA code needs to keep up with this and I'm not able to do it. I managed to make a script that does exactly what I need, however, the code changes for all columns with the name VALOR.
Would I be able to add a way to detect the table name of a cell in this code and only make changes to that detected table?
If you have any optimizations for the code, I would also be grateful, I'm very new to VBA
Thanks guys

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim tableName As String

    On Error Resume Next
    tableName = Me.ListObjects(Target.ListObject.Name).Name
    On Error GoTo 0

    If tableName <> "" Then
        Set rng = Intersect(Target, Me.ListObjects(tableName).ListColumns("VALOR").DataBodyRange)

        If Not rng Is Nothing Then
            Application.EnableEvents = False
            For Each cell In rng
                If cell.Value = "" Or cell.Value = 0 Or cell.Value = Empty Then 'Se o valor for apagado
                    cell.Offset(0, -1).Value = "[DATA]" ' Adiciona "[DATA]" na coluna "DATA"
                    cell.Value = "[VALOR]" ' Adiciona "[VALOR]" na coluna "VALOR"
                    cell.Offset(0, 1).Value = "[O QUE COMPROU]" ' Adiciona "[O QUE COMPROU]" na coluna "DESCRIÇÃO"
                Else
                    cell.Offset(0, -1).Value = Now ' Insere a data atual
                End If
            Next cell
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[mariatti]

This is an example, between a copy of a fortnight of the month to another copy. The table changes its name. And I would like the script to do this detection automatically to only change the values in this table

 

[Akuini]

I don't quite understand what you're trying to do, but maybe this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range

    If Not Target.Cells(1).ListObject Is Nothing Then
        With Target.Cells(1).ListObject
            If IsNumeric(Application.Match("VALOR", .HeaderRowRange, 0)) Then
                Set rng = Intersect(Target, .ListColumns("VALOR").DataBodyRange)
                If Not rng Is Nothing Then
                    Application.EnableEvents = False
                    For Each cell In rng
                        If cell.Value = "" Or cell.Value = 0 Or cell.Value = Empty Then 'Se o valor for apagado
                            cell.Offset(0, -1).Value = "[DATA]" ' Adiciona "[DATA]" na coluna "DATA"
                            cell.Value = "[VALOR]" ' Adiciona "[VALOR]" na coluna "VALOR"
                            cell.Offset(0, 1).Value = "[O QUE COMPROU]" ' Adiciona "[O QUE COMPROU]" na coluna "DESCRIÇÃO"
                        Else
                            cell.Offset(0, -1).Value = Now ' Insere a data atual
                        End If
                    Next cell
                    Application.EnableEvents = True
                End If
            End If
        End With
    End If
End Sub

 

[mariatti]

I don't quite understand what you're trying to do, but maybe this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range

    If Not Target.Cells(1).ListObject Is Nothing Then
        With Target.Cells(1).ListObject
            If IsNumeric(Application.Match("VALOR", .HeaderRowRange, 0)) Then
                Set rng = Intersect(Target, .ListColumns("VALOR").DataBodyRange)
                If Not rng Is Nothing Then
                    Application.EnableEvents = False
                    For Each cell In rng
                        If cell.Value = "" Or cell.Value = 0 Or cell.Value = Empty Then 'Se o valor for apagado
                            cell.Offset(0, -1).Value = "[DATA]" ' Adiciona "[DATA]" na coluna "DATA"
                            cell.Value = "[VALOR]" ' Adiciona "[VALOR]" na coluna "VALOR"
                            cell.Offset(0, 1).Value = "[O QUE COMPROU]" ' Adiciona "[O QUE COMPROU]" na coluna "DESCRIÇÃO"
                        Else
                            cell.Offset(0, -1).Value = Now ' Insere a data atual
                        End If
                    Next cell
                    Application.EnableEvents = True
                End If
            End If
        End With
    End If
End Sub

it continued to change data from any table when I changed data from the VALUE columns.
I will try to explain better what I would like.

I'm making an expense table. it has 4 tables:

One for fixed monthly expenses - Yellow square;
One for credit cards (which is linked to cell E18 to add up the expenses in this table) - Red square;
An income table and a savings table. Blue and purple square, respectively.

To avoid having to create variousExcel files for each month, I preferred to create a copy of this spreadsheet within the same file, for each fortnight. However, when creating these copies, the tables change their name randomly. For example, the table "GastosCC" (name in original table) in the first copy becomes "GastosCC8" in the second copy it becomes "GastosCC19". As shown in the following image:

I would like the script to automatically detect this name change to only work on a specific table. it's possible?

 

[Akuini]

Sorry, I still don't understand the problem.
Hopefully somebody will be able to help.

 

[Georgiboy]

Maybe you could make use of the index number rather than the table name, try stepping through the below on different tabs and you should see it selecting the same tables on each sheet without using the table name:

Sub test()
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    ws.ListObjects(1).DataBodyRange.Select
    ws.ListObjects(2).DataBodyRange.Select
    ws.ListObjects(3).DataBodyRange.Select
    ws.ListObjects(4).DataBodyRange.Select
End Sub

You should be able to use the index number to fix your code.

 

[Georgiboy]

Or maybe the below will help to get the name of the active table:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim tableName As String
    
    On Error Resume Next
        tableName = Target.ListObject.Name
    On Error GoTo 0

    If tableName <> "" Then
        Set rng = Intersect(Target, Me.ListObjects(tableName).ListColumns("VALOR").DataBodyRange)
        If Not rng Is Nothing Then
            rng.Interior.Color = vbRed
        End If
    End If
End Sub

 

[NoSparks]

When I create a sheet with 4 tables as per post #4 and paste the Worksheet_Change code from post #1 into that sheets' code module, then make multiple copies of that sheet in the same workbook things operate the way you would expect them to.
If changes are being made to other tables in your file you must have something else going on.
Think it would be beneficial if you were to share your file so everybody is working on the same thing.

 

[mariatti]

Or maybe the below will help to get the name of the active table:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim tableName As String
   
    On Error Resume Next
        tableName = Target.ListObject.Name
    On Error GoTo 0

    If tableName <> "" Then
        Set rng = Intersect(Target, Me.ListObjects(tableName).ListColumns("VALOR").DataBodyRange)
        If Not rng Is Nothing Then
            rng.Interior.Color = vbRed
        End If
    End If
End Sub

Could I get the table name from a specific cell, instead of the active cell? because I would like this script to only work on one table. In this case, in the red table(credit card table) in answer #4.

 

[mariatti]

When I create a sheet with 4 tables as per post #4 and paste the Worksheet_Change code from post #1 into that sheets' code module, then make multiple copies of that sheet in the same workbook things operate the way you would expect them to.
If changes are being made to other tables in your file you must have something else going on.
Think it would be beneficial if you were to share your file so everybody is working on the same thing.

Sorry, I didn't understand very well...
Would you like me to make the file I am using available to understand better?