CODEWITHSUNDEEP
vbaexcelimport
MVAmorim
MVAmorim

Reputation: 105

VBA Running a macro that Import TXT files results in a big Excel file after cleaning the sheets

I've a simple macro that Import two txt files and put them into separate sheets, apply some formulas, filtering and paste the results in two other sheets. (I'm new to vba so its really simple and basicaly a macro record modified)

My problem is that this macros runs very slow (one of the txt files have 4mb of data, aprox. 14.000 rows and 12 columns. But I've another macro that runs in a instant with the same quant. of rows).

After I run the macro, the excel files get to 9mb. If i clear all the sheets, it still arround 8mb.

Heres the macro: 

 Sub Calcular_dif()
'
' Calcular_dif Macro
'

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' IMPORTA OS DADOS EM TXT DO FINANCEIRO
    Financ = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If Financ = False Then Exit Sub

    With Sheets("FINANCEIRO").QueryTables.Add(Connection:="TEXT;" & Financ, Destination:=Range("FINANCEIRO!$A$1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1)
        .TextFileFixedColumnWidths = Array(3, 7, 52, 10, 4, 11, 11, 11, 12, 6, 3, 17, 17, 17, 17, _
        17, 17, 17, 17, 17, 17)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

' IMPORTA OS DADOS EM TXT DO BALANCETE
    Balanc = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If Balanc = False Then Exit Sub

    With Sheets("BALANCETE").QueryTables.Add(Connection:="TEXT;" & Balanc, Destination:=Range("BALANCETE!$A$1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(14, 6, 3, 41, 16, 3, 15, 16, 16)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

' ORGANIZA A PLANILHA DO FINANCEIRO
    With Sheets("FINANCEIRO")
        .Rows("1:7").Delete Shift:=xlUp
        .Range("$A$1:$V$" & Rows.Count).AutoFilter Field:=1, Criteria1:=Array( _
             "---", "Emp", "Fil", "="), Operator:=xlFilterValues

        .Rows("2:" & Rows.Count).Delete Shift:=xlUp
        .Cells.AutoFilter
        .Range("$A$1:$V$" & Rows.Count).AutoFilter Field:=5, Criteria1:=Array( _
            "AD", "BOB", "BOL", "CAR", "CD", "DEP", "FC", "FOL", "GPS", "GUI", "JUR", "MNT", "PRC", _
            "PRV", "RFS", "RJ", "SIN", "SRE", "SRF", "TAX"), Operator:=xlFilterValues
        .Rows("2:" & Rows.Count).Delete Shift:=xlUp
        .Cells.AutoFilter
        .Range("$A$1:$W$" & Rows.Count).AutoFilter Field:=5, Criteria1:="CON"
        .Range("$A$1:$W$" & Rows.Count).AutoFilter Field:=3, Criteria1:= _
            "<>EXAME AUDITORES INDEPENDENTES - EPP"
        .Rows("2:" & Rows.Count).Delete Shift:=xlUp
        .Cells.AutoFilter
        .Columns("N:N").Insert Shift:=xlToRight
        .Range("N1").FormulaR1C1 = "Liq Contábil"
        .Range("N2:N" & .Range("A" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]-RC[3]-RC[4]-RC[8]"
        .Columns("K:K").NumberFormat = "0"
        .Columns("M:W").Style = "Comma"

    End With

' ORGANIZA A PLANILHA DO BALANCETE
    With Sheets("BALANCETE")
        .Rows("1:6").Delete Shift:=xlUp
        .Range("$A$1:$L$" & Rows.Count).AutoFilter Field:=1, Criteria1:=Array( _
            "BGMRODOTEC TEC", "CNPJ:    00.51", "Conta", "Empresa: 003 P", "="), Operator:= _
            xlFilterValues
        .Rows("2:" & Rows.Count).Delete Shift:=xlUp
        .Cells.AutoFilter
        .Columns("C:C").Delete Shift:=xlToLeft
        .Columns("A:A").Insert Shift:=xlToRight
        .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=LEN(RC[1])"
        .Range("A1:L" & Rows.Count).AutoFilter Field:=1, Criteria1:=Array("7", "10", "="), Operator:=xlFilterValues
        .Rows("2:" & Rows.Count).Delete Shift:=xlUp
        .Cells.AutoFilter
        .Columns("A:A").Delete Shift:=xlToLeft
        .Columns("E:L").Style = "Comma"
        .Columns("B:B").Insert Shift:=xlToRight
        .Rows("1:1").ClearContents
        .Range("A1").FormulaR1C1 = "Classificador"
        .Range("B1").FormulaR1C1 = "Cód."
        .Range("C1").FormulaR1C1 = "Conta"
        .Range("D1").FormulaR1C1 = "Descrição"
        .Range("E1").FormulaR1C1 = "Saldo Anterior"
        .Range("G1").FormulaR1C1 = "Débito"
        .Range("H1").FormulaR1C1 = "Crédito"
        .Range("I1").FormulaR1C1 = "Saldo Atual"
        .Range("K1").FormulaR1C1 = "Financeiro"
        .Range("L1").FormulaR1C1 = "Diferença"

    End With

' INSERE AS FORMULAS DE PROCV PARA COD VS CONTA (FINANCEIRO)
    With Sheets("FINANCEIRO")
        .Columns("C:C").Insert Shift:=xlToRight
        .Range("C2:C" & .Range("A" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-1],'CONT VS COD'!C[-1]:C,2,0)"
        .Range("C1").FormulaR1C1 = "Conta"
        .Cells.EntireColumn.AutoFit

    End With
' INSERE AS FORMULAS DE PROCV PARA COD VS CONTA (BALANCETE)
    With Sheets("BALANCETE")

        .Range("B2:B" & .Range("C" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[1],'CONT VS COD'!C[-1]:C,2,0)"

' INSERE FORMULA DE SOMASE PARA CALCULAR AS DIFERENÇAS
        .Range("K2:K" & .Range("A" & Rows.Count).End(xlUp).Row).FormulaR1C1 = _
            "=SUMIF(FINANCEIRO!C[-8],BALANCETE!RC[-8],FINANCEIRO!C[4])"
        .Range("L2:L" & .Range("A" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-1]-RC[-3]"
        .Range("A1:L" & Rows.Count).AutoFilter Field:=12, Criteria1:="<>0"
        .Cells.Copy Sheets("DIFERENÇAS").Cells
        .Cells.AutoFilter
        .Cells.EntireColumn.AutoFit

    End With

' SEPARA OS NÃO ENCONTRADOS PELO PROCV

    With Sheets("BALANCETE")
        .Range("A1:L" & Rows.Count).AutoFilter Field:=2, Criteria1:="#N/D"
        .Cells.Copy Sheets("NÃO ENCONTRADOS").Cells
        .Rows("2:" & Rows.Count).Delete Shift:=xlUp
        .Cells.AutoFilter

    End With

    Sheets("NÃO ENCONTRADOS").Cells.EntireColumn.AutoFit
    Sheets("DIFERENÇAS").Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

The question is, after I set the variable to be the TXT files, it saves it in the code? Making it slow to run or something?

Thanks

Upvotes: 0

Views: 668

Answers (1)

Degustaf
Degustaf

Reputation: 2670

My guess would be that your code is slow because of the vlookups. I am counting around 28,000. And you are using the exact search option, which does a slow linear search, instead of a much faster bisection search. Try sorting Worksheet("CONT vs COD") on column B first, and then doing an apporximate match.

As for the increased size. It is a well known feature (bug?) that Excel keeps track of the entire range that you have used. Pressing Ctrl + End will show you where excel thinks the end of the worksheet is. Simply select all of the rows that you aren't using, press Delete, and immediately save the workbook. This will remove all of those blank rows that are taking up lots of memory.

Upvotes: 1

Related Questions