VBA Error 6 Overflow macro

Question

I've always used this macro until a few months ago, but today it doesn't work. The error is due to this part, namely

j = j + 1

How can I solve the problem?

This is the code:

Sub StampaVodafone()
Dim i, j As Integer
Dim Fogliotmp As Worksheet
Dim ContoVodafone As String
Dim FoglioElenco As Worksheet
Dim Percorsofile As String
Dim PercorsoSalva As String
Dim ValCell As Variant
Dim strTesto As String
strTesto = "Vuoi procedere con la stampa ?" & vbCr & "SI - Per procedere con la stampa dei dettagli telefonici" & _
         vbCr & "NO - Per andare alla procedura successiva"
If MsgBox(strTesto, 68, "Avvio StampaVodafone") = vbYes Then
    'Procedura di stampa documenti
    i = 1
    Do
        Set Fogliotmp = ActiveWorkbook.Worksheets(i)
        If UCase(Mid(Fogliotmp.Name, 1, 3)) = "TEL" Or UCase(Mid(Fogliotmp.Name, 1, 3)) = "LA " Then
            'Trovo dove sta la fine pagina
            j = 15
            ValCell = Mid(CStr(Fogliotmp.Cells(j, 1).Value), 1, 12)
            Do While (UCase(ValCell) <> "TOTALE COSTI")
                j = j + 1
                ValCell = Mid(CStr(Fogliotmp.Cells(j, 1).Value), 1, 12)
            Loop

            With Fogliotmp.PageSetup
                .LeftMargin = 0
                .RightMargin = 0
                .TopMargin = 0
                .BottomMargin = 0
                .PrintArea = "$A$1:$P$" & CStr(j)
                .LeftHeader = ""
                .CenterHeader = ""
                .RightHeader = ""
                .LeftFooter = ""
                .CenterFooter = ""
                .RightFooter = ""
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0.511811023622047)
                .FooterMargin = Application.InchesToPoints(0.511811023622047)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = False
                .CenterVertically = False
                .Orientation = xlPortrait
                .Draft = False
                .PaperSize = xlPaperA4
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = False
                .EvenPage.LeftHeader.Text = ""
                .EvenPage.CenterHeader.Text = ""
                .EvenPage.RightHeader.Text = ""
                .EvenPage.LeftFooter.Text = ""
                .EvenPage.CenterFooter.Text = ""
                .EvenPage.RightFooter.Text = ""
                .FirstPage.LeftHeader.Text = ""
                .FirstPage.CenterHeader.Text = ""
                .FirstPage.RightHeader.Text = ""
                .FirstPage.LeftFooter.Text = ""
                .FirstPage.CenterFooter.Text = ""
                .FirstPage.RightFooter.Text = ""
            End With
            Application.PrintCommunication = True
            Fogliotmp.PrintOut
        End If
        i = i + 1
        Set Fogliotmp = Nothing
    Loop While (i < ActiveWorkbook.Worksheets.Count + 1)
    MsgBox "Ho terminato di stampare", vbExclamation, "MACRO"
    'Fine procedura stampa
End If
'--
strTesto = "Vuoi procedere con l'estrazione dei file XLSX da spedire agli utenti?" & vbCr & _
         "SI - Inizia la generazione dei file XLSX" & vbCr & _
         "NO - Termina la macro"
If MsgBox(strTesto, 68, "Genera XLS") = vbYes Then
    'Inizio estrazione
    Percorsofile = "C:\ElencoCellEstrazione.xlsx"
    PercorsoSalva = "C:\Estratti"
    ContoVodafone = Application.ActiveWorkbook.Name
    '--
    Set FoglioElenco = Workbooks.Open(Percorsofile).Worksheets(1)
    '--
    i = 1
    Do
        Windows(ContoVodafone).Activate
        Set Fogliotmp = ActiveWorkbook.Worksheets(i)
        If UCase(Mid(Fogliotmp.Name, 1, 3)) = "TEL" Then
            strTesto = Trim(Mid(Fogliotmp.Name, 4, Len(Fogliotmp.Name)))
            'Cerco il nome della persona
            j = 2
            ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
            Do While (UCase(ValCell) <> UCase(strTesto) And UCase(ValCell) <> "END LIST")
j = j + 1
                ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
            Loop
            If UCase(ValCell) <> "END LIST" Then
                'Ho il nome dell'intestatario del telefono
                ValCell = Trim(CStr(FoglioElenco.Cells(j, 2).Value))
                strTesto = PercorsoSalva & ValCell
                'Salvo il documento
                 Windows(ContoVodafone).Activate
                 Sheets(Fogliotmp.Name).Select
                 Sheets(Fogliotmp.Name).Copy
                 ActiveWorkbook.SaveAs Filename:=strTesto, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                 ActiveWindow.Close
                 Windows(ContoVodafone).Activate
            End If
        End If
        '--
        i = i + 1
        Set Fogliotmp = Nothing
        Windows(ContoVodafone).Activate
    Loop While (i < ActiveWorkbook.Worksheets.Count + 1)
    MsgBox "Ho terminato gli export XlsX", vbExclamation, "MACRO"
End If
End Sub

I have already try to change

Dim i, j As Integer

to

Dim i As Integer, Dim j As Long

But the error changes to 1004 in the row:

ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))

What escapes me?

Not answering as Vityata seems to have that in hand - but all those values you're setting in the PageSetup aren't required. Most are default values and will be set as that anyway. Pretty sure you only need have .PrintArea = "$A$1:$P$" & CStr(j) in that whole block - the rest can be removed. — Darren Bartrup-Cook
– Darren Bartrup-Cook, Commented Sep 11, 2017 at 10:29
I remove the rest of in that block. Same problem, error 1004 into row 'ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))' — Razel
– Razel, Commented Sep 11, 2017 at 13:50

Vityata · Accepted Answer · 2017-09-11 08:48:11Z

3

In general, Integer should not be used in VBA. It is smaller and slower than Long -> Why Use Integer Instead of Long?

Thus, redeclare your integers to long and the Overflow error should be fixed:

Dim i as long, j As long

Concerning the second error, try Dim ValCell as String or give more information about its value.

edited Sep 11, 2017 at 8:48

answered Sep 11, 2017 at 8:36

Vityata

43.8k10 gold badges64 silver badges110 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

Razel Over a year ago

I have modified what you have indicated to me. 'Dim ValCell as String' i have the same errore: 1004. Valute into 'ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))' j=1048577

Vityata Over a year ago

@Razel - you get 1004, because the excel rows are exactly 1048576 (2^20). Once you want to refer more rows, excel does give you 1004 - object not found. Rewrite your logic.

Razel Over a year ago

The strange thing is that the macro worked up to two months ago

Vityata Over a year ago

@Razel - you were not reaching 2^20 back then.

Collectives™ on Stack Overflow

VBA Error 6 Overflow macro

1 Answer 1

4 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

4 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related