Creating a counter that will not reset at any point

[Joe9238]

Hi all,
I have some code that will create a counter and add 1 each time the criteria is fulfilled. This is inside a loop and I have found that the counters will reset outside of this loop. Is there a way to make the counters the same value throughout the code? All help is much appreciated.

 

[Joe4]

Please post your code, and we may be help you to modify it.

 

[Joe9238]

Here it is. I didn't think to do this initially as there is quite a lot to follow.

 Option Explicit


Sub CountFiles()

Range("A1").Value = "Type"
Range("A2").Value = "All Time"
Range("B1").Value = "Duplicates"
Range("C1").Value = "Replicates"
Range("D1").Value = "Vinyl"
Range("A4").Value = "Errors"
    Dim sFolder As String
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder..."
        .Show
        If .SelectedItems.count > 0 Then
            sFolder = .SelectedItems(1) & "\"
    End If
    End With
    Call Consolidate(sFolder, ThisWorkbook)
End Sub


Private Sub Consolidate(strFolder As String, wbMaster As Workbook)

Application.ScreenUpdating = False
Application.EnableEvents = False
    Dim wbTarget As Workbook
    Dim objFso As Object
    Dim objFiles As Object
    Dim objSubFolder As Object
    Dim objSubFolders As Object
    Dim objFile As Object
    Dim ary(3) As Variant
    Dim lRow As Long
    Dim count As LongPtr
    Dim count1 As LongPtr
    Dim count2 As LongPtr
    Dim countZ As LongPtr
    Dim countE As LongPtr
    Dim sheet As Variant
    On Error GoTo linemarkerError
    'Create objects to enumerate files and folders
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = objFso.getfolder(strFolder).Files
    Set objSubFolders = objFso.getfolder(strFolder).Subfolders


    'Loop through each file in the folder
    For Each objFile In objFiles
    On Error GoTo linemarkerError
        If InStr(1, objFile.Path, ".xls") > 0 Then 'change the file type if needed but this will do all workbooks
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
            Set wbTarget = Workbooks.Open(objFile.Path)
            Set sheet = wbTarget.Sheets
            
            For Each sheet In wbTarget.Sheets
            On Error GoTo linemarkersheet
linemarkerback:      If sheet.Name = "JOB SHEET" Then                  'change the sheetname as appropriate
        countZ = 1
         Exit For
      End If
   Next sheet
   On Error GoTo linemarker2
                  With ThisWorkbook.Worksheets(1)
         If countZ = 1 Then GoTo linemarker1 Else GoTo linemarker2
         End With
            
linemarker1: countZ = 0                             '======================================================
         
            If wbTarget.Worksheets("JOB SHEET").Range("A16").Value = "NUMBER OF DISCS" Then GoTo LinemarkerA Else GoTo LinemarkerA2
LinemarkerA:           count = count + 1
         GoTo linemarker2 '====================================================


LinemarkerA2:     If wbTarget.Worksheets("JOB SHEET").Range("A16").Value = "CD/DVD/PRINT ONLY" Then GoTo linemarkerC Else GoTo LinemarkerB2
linemarkerC:      count1 = count1 + 1
          GoTo linemarker2         '====================================================================
            
LinemarkerB2:  If wbTarget.Worksheets("JOB SHEET").Range("A16").Value = "TP' S" Then GoTo linemarkerE Else GoTo LinemarkerC2 ' this is c2 not 2
linemarkerE:    count2 = count2 + 1
LinemarkerC2:


linemarker2:   countZ = 0
            wbTarget.Close savechanges:=False
        End If
        
                ary(0) = count
                ary(1) = count1
                ary(2) = count2
                ary(3) = countE
                With wbMaster.Worksheets(1)
                lRow = .Range("F" & .Rows.count).End(xlUp).Offset(1, 0).Row
                .Range("F" & lRow & ":I" & lRow) = ary
            End With
        
        If count + count1 + count2 = 451 Then GoTo linemarkerEY Else GoTo linemarker3
linemarkerEY: GoTo linemarker3
        
        'On Error Resume Next
linemarker3:    Next objFile
    'now for the subfolders subfolders
    For Each objSubFolder In objSubFolders
        Consolidate objSubFolder.Path, wbMaster
        Next objSubFolder
        
    'paste final results
    If count + count1 + count2 <> 0 Then
    With ThisWorkbook.Worksheets(1)
    Range("B2").Value = count
    Range("C2").Value = count1
    Range("D2").Value = count2
    Range("B4").Value = countE
    End With
        End If
    
    'Clean up
    Set objFile = Nothing
    Set objFiles = Nothing
    Set objFso = Nothing
            Application.DisplayAlerts = True
            Application.AskToUpdateLinks = True
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            GoTo linemarkerendsub
            
linemarkerError:  countE = countE + 1
            GoTo linemarker3
linemarkersheet:      sheet.Unprotect Password:="Heslo"
                       GoTo linemarkerback
            
linemarkerendsub:
End Sub

 

[Joe4]

So which variable is your counter?

 

[Joe9238]

Don't worry about it, I found a way around it. Thank you though.