Macro calling a function without being required (VBA)

554 views Asked by At

I made this sub in VBA which copies the contents of a sheet to a new sheet, then format and save this as a .csv. But when I'm debugging this, the sub jumps alone to a function in another module and starts an infinite loop. Depending on the organization of the commands, it jumps before or after for this function, but always skips. in the current sub is jumping in the ".move" command.

I have not found the solution because the polls always return something like: "How to do a sub automatically call a function?" But that is precisely what is happening to me without my will.

That is my Sub


Sub TCzor()
'

Dim MData, MStr
Dim ultimalinha As Integer
Dim valorA As String
Dim valorB As String
Dim valorC As String
Dim valorD As String
Dim sUserName As String

MData = Date
MStr = Format(MData, "ddmm")
sUserName = Environ$("username")
'

    Windows("MultiTrat.xlsm").Activate
    Sheets("MultiTrat").Select

    Sheets.Add After:=ActiveSheet

    ActiveSheet.Name = "TCzor"

    Sheets("MultiTrat").Select


    Range("AX3:BF111").Select

    Application.CutCopyMode = False
    Selection.Copy
    Sheets("TCzor").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$I$109").AutoFilter Field:=1, Criteria1:="="
    Rows("2:2").Select
    Range(Selection, Rows("1000:1000")).Select

    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("G:G").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Range(Selection, Columns("XFD:XFD")).Select
    Selection.Delete Shift:=xlToLeft
    Range("D1").Value = "Valor"
    Columns("D:D").Select
    Selection.NumberFormat = "0.00"

    ultimalinha = Range("A1").End(xlDown).Row

    For linha = 2 To ultimalinha
        If Cells(linha, 3).Value = "C" Then
        Cells(linha, 3).Value = "Créd"
        Else
        Cells(linha, 3).Value = "Déb"
        End If
    Next linha

    For linha = 1 To ultimalinha
        valorA = Cells(linha, 1)
        valorB = Cells(linha, 2)
        valorC = Cells(linha, 3)
        valorD = Cells(linha, 4)
        Cells(linha, 1) = valorA & ";" & valorB & ";" & valorC & ";" & valorD
    Next linha

    Range("B:D").Delete

    Sheets("TCzor").Select
    Sheets("TCzor").Move
    ChDir "C:\Users\" & sUserName & "\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\" & sUserName & "\Desktop\TC" & MStr & ".csv", FileFormat:=xlCSV, _
        CreateBackup:=False
    ActiveWindow.Close
    Windows("tczor_jv.xlsm").Activate
End Sub

And this is the Function that it is calling by itself

Function GetARN(Myrange As Range) As String
    Dim regex As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String

    strPattern = "[0-9]{23}"

   strInput = Myrange.Value

   With regex
       .Global = True
       .MultiLine = True
       .IgnoreCase = False
       .Pattern = strPattern
   End With

   Set matches = regex.Execute(strInput)

   For Each Match In matches
       GetARN = Match.Value
   Next Match
0

There are 0 answers