VBA code works in Excel 2010 but not in Office 365

[Vagrant718]

I have this vba code that I was running previously in Excel 2010 on windows 7. In a nutshell the code is creating a new worksheet and is copy and pasting the recordset into the new worksheet. Then the code will do a lookup and insert new data into that same worksheet. Recently, the business updated our office suite to Office 365. After that, everything in the code works up until the bolded. The bolded part of the code does not produce the results in office365. I ran the code line for line in office365 and cannot seem to figure out where the incompatibility is occurring. Can anyone help me figure this out?

Public Sub LinkCycle()
'dual purpose sub: 1) to populate the "Records" column in the exception sheet. 2) to create an exception report to send to sub/ GIS contacts to review.
'this sub is expected to be called from 3 sheets: "Exceptions","Email Report"(R),"SUN ID Report"(R). (R)=create exception report.
Dim errorFlag As Double
Call setGlobal
Dim tbl As ListObject
Dim masterWBNm As String, masterShtNm As String
Set tbl = exceptionTbl
masterWBNm = ThisWorkbook.Name
masterShtNm = ActiveSheet.Name

If masterShtNm <> dashboardShtNm Then
    Call OptimizeCode_Begin
End If

Dim colNm_date As String, colNm_rule As String, colNm_subSource As String, colNm_records As String, colNm_release As String
Dim col_date As Integer, col_rule As Integer, col_subSource As Integer, col_records As Integer, col_release As Integer
Dim headerRow As Integer
colNm_date = "True Date"
colNm_rule = "Rule"
colNm_subSource = "Subsidiary or Source System"
colNm_records = "Records"
colNm_release = "Initial Release As Of Date"
col_date = tbl.ListColumns(colNm_date).Range.Column
col_rule = tbl.ListColumns(colNm_rule).Range.Column
col_subSource = tbl.ListColumns(colNm_subSource).Range.Column
col_records = tbl.ListColumns(colNm_records).Range.Column
col_release = tbl.ListColumns(colNm_release).Range.Column

headerRow = tbl.HeaderRowRange.Row

'method explained: we create an array of the unique hyperlinks in the rule column-- that way, we can open each link ONCE instead of once per
'sub/source. in 3 other arrays, we store information PER hyperlink: the rule name, as of date, and the date the rule was implemented (release date).
'in 1 array, we store information PER hyperlink PER row in which the hyperlink occurs: the sub/source and the row index.

Dim cell_selector As Range
Dim rulePath As String
Dim hyperlinkArr() As String, hyperlinkArrSize As Double 'array of hyperlinks
Dim hyperlinkDict As Object 'dictionary with key=hyperlink, value=index of hyperlink in hyperlink array
Dim findIndex As Double 'to retrieve value from dictionary
Dim subSourceArr() As Variant, insertSubSourceArr() As String 'arrary of subs/sources per hyperlink
Dim insertSubSource As String, insertRule As String, insertDate As Date, insertRelease As Date
Dim ruleArr() As Variant, dateArr() As Date, releaseArr() As Date
Dim indexArr() As Variant, insertIndexArr() As Long

hyperlinkArrSize = -1
subSourceArrSize = -1
ruleArrSize = -1
releaseArrSize = -1
Set hyperlinkDict = CreateObject("Scripting.Dictionary")

For Each cell_selector In tbl.ListColumns(col_rule).DataBodyRange.SpecialCells(xlCellTypeVisible)
    rulePath = cell_selector.Hyperlinks(1).Address
    insertSubSource = tbl.DataBodyRange(cell_selector.Row - headerRow, col_subSource)
    insertRule = tbl.DataBodyRange(cell_selector.Row - headerRow, col_rule)
    insertDate = tbl.DataBodyRange(cell_selector.Row - headerRow, col_date)
    insertRelease = tbl.DataBodyRange(cell_selector.Row - headerRow, col_release)
    ReDim insertIndexArr(0)
    ReDim insertSubSourceArr(0)
    If Not IsInArray(rulePath, hyperlinkArr) Then
        pp hyperlinkArrSize
      
        ReDim Preserve hyperlinkArr(hyperlinkArrSize)
        hyperlinkArr(hyperlinkArrSize) = rulePath
        hyperlinkDict.Add rulePath, hyperlinkArrSize
      
        ReDim Preserve ruleArr(hyperlinkArrSize)
        ruleArr(hyperlinkArrSize) = insertRule
      
        ReDim Preserve dateArr(hyperlinkArrSize)
        dateArr(hyperlinkArrSize) = insertDate
      
        ReDim Preserve releaseArr(hyperlinkArrSize)
        releaseArr(hyperlinkArrSize) = insertRelease
      
        'Arrays that need to be updated for each row
        ReDim Preserve indexArr(hyperlinkArrSize)
        insertIndexArr(0) = cell_selector.Row - headerRow
        indexArr(hyperlinkArrSize) = insertIndexArr
      
        ReDim Preserve subSourceArr(hyperlinkArrSize)
        insertSubSourceArr(0) = insertSubSource
        subSourceArr(hyperlinkArrSize) = insertSubSourceArr
    Else
        findIndex = hyperlinkDict(rulePath)
        insertIndexArr = indexArr(findIndex)
        insertSubSourceArr = subSourceArr(findIndex)
        If Not IsInArray(insertSubSource, insertSubSourceArr) Then
            ReDim Preserve insertIndexArr(UBound(insertIndexArr) + 1)
            insertIndexArr(UBound(insertIndexArr)) = cell_selector.Row - headerRow
            indexArr(findIndex) = insertIndexArr
      
            ReDim Preserve insertSubSourceArr(UBound(insertSubSourceArr) + 1)
            insertSubSourceArr(UBound(insertSubSourceArr)) = insertSubSource
            subSourceArr(findIndex) = insertSubSourceArr
        End If
    End If
Next cell_selector

Set hyperlinkDict = Nothing
Erase insertSubSourceArr

Dim fillRecordsRng As Range
Set fillRecordsRng = tbl.ListColumns(col_records).DataBodyRange.SpecialCells(xlCellTypeVisible)

Dim loopCounter As Double 'status bar progress
Dim RS As Object, RSFlag As Boolean: Set RS = CreateObject("ADODB.Recordset")
Dim ruleNm As String, ruleShtNm As String, exceptionDate As Date, releaseDate As Date 'info from exception table
Dim fileType As Integer, orgHeader As String, orgFilter As String 'determined from info from exception table
Dim filterRecordCount As Double 'used to populate records column
Dim startRow As Double, fieldCounter As Integer, reportCellSelector As Range 'iterate in reportWB
Dim exceptionRows As Integer, findOrgHeaderCol As Integer 'iterate in exception WB
loopCounter = 0

If masterShtNm <> exceptionShtNm Then 'creates report if called from anywhere except exception sheet
    Dim reportWB As Workbook
    Set reportWB = Workbooks.Add
End If

For i = 0 To hyperlinkArrSize
    rulePath = hyperlinkArr(i)
    ruleNm = ruleArr(i)
    ruleShtNm = Left(ruleNm, 31)
    exceptionDate = dateArr(i)
    releaseDate = releaseArr(i)
  
    If Len(ruleNm) < 49 And exceptionDate <> CDate("6/26/2018") Then
        'open exception file as recordset
        RSFlag = True
        Set RS = WSToRS_NoHdr(rulePath)
        RS.Open
    ElseIf Len(ruleNm) >= 49 And exceptionDate <> CDate("6/26/2018") Then
        Dim exceptionWB As Workbook 'open exception file as workbook
        RSFlag = False
        Workbooks.Open rulePath, ReadOnly:=True
        Set exceptionWB = ActiveWorkbook
    End If
  
    For j = 0 To UBound(subSourceArr(i))
        pp loopCounter
        Application.StatusBar = "Progress:  " & loopCounter & "/" & tbl.ListColumns(col_rule).DataBodyRange.SpecialCells(xlCellTypeVisible).Count
        orgFilter = subSourceArr(i)(j)
        fileType = fileTypeDetermine(ruleNm, exceptionDate, releaseDate, orgHeader)
      
        If orgFilter = "DDA" And ruleNm = "IDL_007_TransferAmount_1" Then
            orgFilter = "NY"
        End If
      
        If masterShtNm <> exceptionShtNm Then
            If RSFlag And exceptionDate <> CDate("6/26/2018") Then 'populate report using recordset
                With reportWB
                    reportWB.Activate
                    If Evaluate("ISREF('" & ruleShtNm & "'!A1)") Then
                        'if sheets already exists, paste data starting at appropriate row
                        startRow = .Sheets(ruleShtNm).UsedRange.Rows.Count + 1
                    Else
                        .Sheets.Add().Name = ruleShtNm
                        For fieldCounter = 0 To RS.Fields.Count - 1 'add header
                            .Sheets(ruleShtNm).Cells(1, fieldCounter + 1) = RS.Fields(fieldCounter).Name
                        Next fieldCounter
                        startRow = 2
                    End If
                    RS.Filter = orgHeader & " = '" & orgFilter & "'"
                    .Sheets(ruleShtNm).Cells(startRow, 1).CopyFromRecordset RS
                  
                    .Sheets(ruleShtNm).Select
                    Range(.Sheets(ruleShtNm).Cells(startRow, 1), .Sheets(ruleShtNm).Cells(startRow, RS.Fields.Count)).Select
                    If RS.RecordCount > 1 Then
                        Range(Selection, Selection.End(xlDown)).Select
                    End If
                  
                    For Each reportCellSelector In Selection 'recordset loses formatting, need to account for this
                        reportCellSelector.Value = reportCellSelector.Value
                    Next reportCellSelector
                End With
              
                filterRecordCount = RS.RecordCount
              
            ElseIf Not RSFlag And exceptionDate <> CDate("6/26/2018") Then 'populate report using workbooks.open. exception ws will be the active sheet
                ActiveSheet.Cells(1, 1).AutoFilter Field:=ActiveSheet.Range("A1:AA1").Find(orgHeader).Column, Criteria1:=orgFilter
                exceptionRows = WorksheetFunction.CountA(ActiveSheet.Columns(1))
                exceptionCols = WorksheetFunction.CountA(ActiveSheet.Rows(1))
                Range(Cells(1, 1), Cells(exceptionRows, exceptionCols)).SpecialCells(xlCellTypeVisible).Select
                filterRecordCount = Selection.Rows.Count - 1
                Selection.Copy
              
                With reportWB
                    .Activate
                    If Evaluate("ISREF('" & ruleShtNm & "'!A1)") Then 'if sheets already exists, paste data starting at appropriate row
                        startRow = .Sheets(ruleShtNm).UsedRange.Rows.Count + 1
                        .Sheets(ruleShtNm).Paste Destination:=.Sheets(ruleShtNm).Cells(startRow, 1)
                        .Sheets(ruleShtNm).Rows(startRow).Delete
                    Else
                        .Sheets.Add().Name = ruleShtNm
                        startRow = 1
                        .Sheets(ruleShtNm).Paste Destination:=.Sheets(ruleShtNm).Cells(startRow, 1)
                    End If
                End With
            End If
        Else 'only need to populate records if called from exceptions sheet
            If RSFlag And exceptionDate <> CDate("6/26/2018") Then
                RS.Filter = orgHeader & " = '" & orgFilter & "'"
                filterRecordCount = RS.RecordCount
            ElseIf Not RSFlag And exceptionDate <> CDate("6/26/2018") Then
                findOrgHeaderCol = ActiveSheet.Range("A1:AA1").Find(orgHeader).Column
                ActiveSheet.Cells(1, 1).AutoFilter Field:=findOrgHeaderCol, Criteria1:=orgFilter
                exceptionRows = WorksheetFunction.CountA(ActiveSheet.Columns(1))
              
                'filterrecordcount for workbooks open method assumes that org field is populated for all records
                filterRecordCount = Range(ActiveSheet.Cells(1, findOrgHeaderCol), ActiveSheet.Cells(exceptionRows, findOrgHeaderCol)).SpecialCells(xlCellTypeVisible).Count - 1
            End If
          
            tbl.DataBodyRange(indexArr(i)(j), col_records) = filterRecordCount
        End If
    Next j
    If RSFlag And exceptionDate <> CDate("6/26/2018") Then
        RS.Close
    ElseIf Not RSFlag And exceptionDate <> CDate("6/26/2018") Then
        Application.DisplayAlerts = False
        exceptionWB.Close savechanges:=False
        Application.DisplayAlerts = True
    End If
Next i

Set RS = Nothing

If masterShtNm <> exceptionShtNm And masterShtNm <> dashboardShtNm Then
Dim rCol_ruleNm As Integer, rCol_ruleCondition As Integer
Dim findRuleRow As Integer, findRuleCondition As String
rCol_ruleNm = ruleTbl.ListColumns("Rule Name").Range.Column
rCol_ruleCondition = ruleTbl.ListColumns("DQ Business Rule/Condition").Range.Column

'formatting
For k = 1 To reportWB.Sheets.Count - 3
With reportWB.Sheets(k)
.Cells.EntireColumn.AutoFit
.Rows("1:5").Insert
.Cells(1, 1) = "DQ Rule:"
findRuleRow = Application.WorksheetFunction.Match("*" & Sheets(k).Name & "*", ruleTbl.ListColumns(rCol_ruleNm).DataBodyRange, 0)
findRuleCondition = CStr(ruleTbl.DataBodyRange(findRuleRow, rCol_ruleCondition))
.Cells(1, 2) = findRuleCondition
.Cells(3, 1) = "Fields:"
.Cells(4, 1).AutoFilter
.Select
End With
'freeze panes
With ActiveWindow
.SplitColumn = 0
.SplitRow = 4
.FreezePanes = True
End With
Next k
End With

'dummy sheets
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Application.DisplayAlerts = True
'return to first sheet
Sheets(1).Select

    End If
If masterShtNm <> dashboardShtNm Then
Call OptimizeCode_End
End If
End Sub

 

[MARK858]

Cross-posted without a link here

 

[Fluff]

@Vagrant718
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[RoryA]

What specifically does "The bolded part of the code does not produce the results in office365" mean, please?

 

[Vagrant718]

What specifically does "The bolded part of the code does not produce the results in office365" mean, please?

Mean that the bold part of the code works in excel 2010 but it "skips" that portion in 365 so its like the code works up until the bolded

 

[Kyle123]

Sound more like your if clause is returning false to me. I’d check that first