Generate Tables and insert formulas with variable range (VBA)

Question

Good afternoon to all!

I’m trying to develop a code to export reports in an automated way and optimize my time at work, but I’m having difficulty in a few steps.

I will put step by step what is my intention, to better exemplify.

What I want to do?

1. Export database report (ok)

2. Delete some columns (ok)

3. Insert formula Cont.ses and delete repeated lines

4. Select range and leave only unique records

5. Generate dynamic table

6. Generate dynamic graph (ok)

7. Send result by email

Which point is giving problem?

In step 3 (Insert formula Cont.ses and delete repeated lines) my code displays error "Runtime error 1004 the Global range object failed".

At this point, I’m trying to insert a code that is able to scan my file and identify the last row of my first two columns, add the formula (cont.ses) to a third column, apply it to this whole new column. Then my code needs to select the full range of the three columns and keep only the unique records.

My intention is to select only the unique records to generate a dynamic chart (part I’m managing to do).

What’s wrong with me?

The problem is that I need to generate a code that works for any number of rows and range I export (columns do not vary), because as this is a production report, it will always be variable. I get my code to identify the last line, but not then select and apply the formulas and generate the table for any interval that arises.

Some help would be most welcome, please.

Follow the code I’m trying (still without the dynamic table)

Sub Relatorio ()


    Dim Caminho As String
    Dim linha As Integer
    Dim pergunta As Integer
    Dim ult_lin As Long, ult_lin2 As Long
    Dim intervalo As Range


    pergunta = MsgBox("Deseja Exportar este Relatório?", vbYesNo)

    If pergunta = vbYes Then

        ' Abrir arquivo

        Caminho = ThisWorkbook.Path
        Workbooks.Open ("C:\Users\Usuários
        Convidados\Desktop\VBA\Testes\dadosbrutos")
        Sheets("Sheet").Select


        Sheets("Sheet").Activate

        'Excluir colunas Macro

        Columns("C:E").Delete


        ' Adicionar formula contagem

        ult_lin = Range("A3").End(xlDown).Row    'encontrar ultima linha da coluna A
        ult_lin2 = Range("B3").End(xlDown).Row   'encontrar ultima linha da coluna B

        Range("C3").Value = "Contagem"
        Range("C4").Value = Application.WorksheetFunction.CountIfs(Range("A3:A"),
        Cells(ult_lin, 1).Value, Range("B3:B"), Cells(ult_lin2, 2).Value) 'AQUI
        'APRESENTA O ERRO MENCIONADO
        Selection.AutoFill Destination:=Cells(ult_lin, 3) 'POSSÍVEL PONTO DE ERRO,
        'POIS NÃO CONSIGO USAR ult_lin COM OBJETO RANGE.

        ' deixar somente registros exclusivos

        For Each cell In Worksheets("Sheet").Range("A1").CurrentRegion

            If Cells <> "" Then

                AdvancedFilter Action:=xlFilterInPlace, Unique:=True 'não sei qual
                range botar aqui no inicio para completar o comando a lado

            End If

        Next

End Sub

Answer 1

I’m not sure I understand what you need, but I hope this code helps:

Sub Relatorio ()

Dim Caminho As String
Dim linha As Integer
Dim pergunta As Integer
Dim ult_lin As Long, ult_lin2 As Long
Dim intervalo As Range

pergunta = MsgBox("Deseja Exportar este Relatório?", vbYesNo)

If pergunta = vbYes Then    ' Abrir arquivo

    Caminho = ThisWorkbook.Path
    Workbooks.Open ("C:\Users\UsuáriosConvidados\Desktop\VBA\Testes\dadosbrutos")
    Sheets("Sheet").Activate

    Activesheet.Columns("C:E").Delete    'Excluir colunas Macro

    ' Adicionar formula contagem
    ult_lin = Range("A3").End(xlDown).Row    'encontrar ultima linha da coluna A
    ult_lin2 = Range("B3").End(xlDown).Row   'encontrar ultima linha da coluna B

    Range("C3").Value = "Contagem"
    Range("C4").Value = Application.WorksheetFunction.CountIfs(Range("A3:A" & ult_lin), Cells(ult_lin, 1).Value, Range("B3:B" & ult_lin2), Cells(ult_lin2, 2).Value) 'AQUI APRESENTA O ERRO MENCIONADO
    Selection.AutoFill Destination:=Cells(ult_lin, 3) 'POSSÍVEL PONTO DE ERRO, POIS NÃO CONSIGO USAR ult_lin COM OBJETO RANGE.

    ' deixar somente registros exclusivos
    'Verifique o argumento Action
    Activesheet.Range("A1:C" & ult_lin).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("D1:E2"), Unique:=True    'Troque o CriteriaRange para o seu intervalo de critérios
End if

End Sub

Answer 2

• Their doubts were not clear, could make available some data?
• What is the criterion for 'Countifs' ?

in the correction below adopted as criterion ">10"

    Range("C4").Value = Application.WorksheetFunction.CountIfs(Range("A3:A" & ult_lin), ">10")
    Range("C4").Value = Range("C4").Value + Application.WorksheetFunction.CountIfs(Range("B3:B" & ult_lin2), ">10")