VBA Code used twice, keeps table formatting on one sheet, but not on the other

[JeffGrant]

Hi All,

I have this code that loads an array, does a search and replace and write the array back out again.
One one sheet, the array is read in from a table and written out again as a table. No problem.

One the second sheet, the array is read from a table and written out as cells values. The table structure is gone and I don't understand why.

The only difference between the two modules is line Set shttblMergeMeeting = Sheet11, with the associated With Statement for writing the array out again.


Any and all assistance is well appreciated.

The code is:

Sub Timer2BMFNR_Mod()

    'Range Variables
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, Rng5 As Range, Rng6 As Range, RngWhole As Range
    
    'Variant Variables
    Dim ArrWhole As Variant, Arr1 As Variant, Arr3 As Variant, Arr4 As Variant, Arr5 As Variant, Arr6 As Variant, FndList As Variant
    
    'Worksheet Variables
    Dim shttblMergeMeeting As Worksheet, shtFndList As Worksheet
    
    'Integer Variables
    Dim xx As Integer, Count As Integer
    
    'Long Variable
    Dim lRow As Long, lCol As Long

    Application.ScreenUpdating = False
    
    Set shttblMergeMeeting = Sheet11
    Set shtFndList = Sheet27
    
    With shttblMergeMeeting
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
        lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        'Data Range to look in
        Set rng1 = .Range("G1:G" & lRow)
        
        'Data Range to Replace
        Set rng2 = shtFndList.Range("A1").CurrentRegion
        Set rng3 = .Range("AM1:AM" & lRow)
        Set rng4 = .Range("AX1:AX" & lRow)
        Set Rng5 = .Range("B1:B" & lRow)
        Set Rng6 = .Range("AW1:AW" & lRow)
        
        FndList = rng2.Value2
  
        
        Set RngWhole = .Range(.Cells(1, "A"), .Cells(lRow, lCol))
        ArrWhole = RngWhole.Value2
        
    End With
        
    ' Clean up known issues
    With Application
        ArrWhole = .Substitute(ArrWhole, Chr(160), " ")
        ArrWhole = .Trim(ArrWhole)
        
        'Columns B = 2 G=7 AM=39 AW = 49 AX=50
        Arr1 = .Index(ArrWhole, 0, 7)   'Class Restrictions
        Arr3 = .Index(ArrWhole, 0, 39)  'Form Class Restiction
        Arr4 = .Index(ArrWhole, 0, 50)  'Form Track Condition
        Arr5 = .Index(ArrWhole, 0, 2)   'Track
        Arr6 = .Index(ArrWhole, 0, 49)  'Form Track
        
        For xx = 3 To UBound(FndList)
            If Count <= 58 Then
            Application.StatusBar = "Replacing Classes"
                ElseIf Count <= 60 Then
                    Application.StatusBar = "Replacing Tracking Conditions"
                    Else:
                        Application.StatusBar = "Replacing Tracks"
            End If
                
            Arr1 = .Substitute(Arr1, FndList(xx, 1), FndList(xx, 2))
            Arr3 = .Substitute(Arr3, FndList(xx, 1), FndList(xx, 2))
            Arr4 = .Substitute(Arr4, FndList(xx, 1), FndList(xx, 2))
            Arr5 = .Substitute(Arr5, FndList(xx, 1), FndList(xx, 2))
            Arr6 = .Substitute(Arr6, FndList(xx, 1), FndList(xx, 2))

            Count = Count + 1
        Next xx
        
    End With
    
    
    With shttblMergeMeeting
        ' The order matters write back arrWhole first
        .Range("A1").Resize(UBound(ArrWhole, 1), UBound(ArrWhole, 2)).Value2 = ArrWhole
        .Range("G1").Resize(UBound(Arr1)).Value2 = Arr1
        .Range("AM1").Resize(UBound(Arr3)).Value2 = Arr3
        .Range("AX1").Resize(UBound(Arr4)).Value2 = Arr4
        .Range("B1").Resize(UBound(Arr5)).Value2 = Arr5
        .Range("AW1").Resize(UBound(Arr6)).Value2 = Arr6
    End With

    Application.ScreenUpdating = True
    Application.Goto Sheet5.Range("A1") 'Return to Home Sheet
    Range("A1").Select
End Sub

 

[JeffGrant]

Ah - Ha...looks like I answered my own question with a bit more research.
By Changing this this line:
Set RngWhole = .Range(.Cells(1, "A"), .Cells(lRow, lCol))
to this
Set RngWhole = Sheet11.ListObjects("tbl_Merge_Meeting_2").DataBodyRange

I am actually referencing the table object. Which leads me to think that where the code is working on the first sheet, it is only working because Excel is "guessing" what to do, where as on the second sheet, I have defined what to do. Interesting that it has been working all this time on the first sheet, without throwing any errors.

 

[JeffGrant]

Oops...I am too fast to update this forum.

The issue with this line:
Set RngWhole = Sheet11.ListObjects("tbl_Merge_Meeting_2").DataBodyRange which is does not read the header,
however, when the data is being written out, the first row of the data is being treated as a new header.

Any ideas on how to keep the headers? thanks

 

[Alex Blakenburg]

Just swap out the DataBodyRange for just Range ie

Set RngWhole = Sheet11.ListObjects("tbl_Merge_Meeting_2").Range

 

[smozgur]

Oops...I am too fast to update this forum.

The marked solution has been changed with the actual answer post.