Exce Macro VBA to unfreeze Panes from a sheet from multiple Workbooks

[manjarigoyal]

I wrote a macro to consolidate the multiple excel workbooks in one. Each Excel workbook has multiple sheets(Workbook "A", Workbook "B" etc. and each workbook has 8 sheets(Sheet1, Sheet2, Sheet3 etc..). This macro is designed to consolidate Sheet 3 from all workbooks in one. All Sheet3 has freeze panes and filters in there. Now I need help to add a function in this existing macro where it can unfreeze and unfiltered the panes from only Sheet 3 from each workbook before consolidating them. I am not sure how to do it. The macro has two modules, one is File manager and the other one is Module1.

The code for ModFManager is below:

Public fPath As String
Public IsSubFolder As Boolean
Public iRow As Long
Public FSO As Scripting.FileSystemObject
Public SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Public FileItem As Scripting.File
Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)

On Error Resume Next
For Each FileItem In SourceFolder.Files
' display file properties
Cells(iRow, 2).Formula = iRow - 13
Cells(iRow, 3).Formula = FileItem.Name
Cells(iRow, 4).Formula = FileItem.Path
Cells(iRow, 5).Formula = Int(FileItem.Size / 1024)
Cells(iRow, 6).Formula = FileItem.Type
Cells(iRow, 7).Formula = FileItem.DateLastModified
Cells(iRow, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

iRow = iRow + 1 ' next row number
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder, True
Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

Call ResultSorting(xlAscending, "C14", "D14", "E14")

End Sub


Sub ResultSorting(xlSortOrder As String, sKey1 As String, sKey2 As String, sKey3 As String)
Range("C13").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Sort Key1:=Range(sKey1), Order1:=xlSortOrder, Key2:=Range(sKey2 _
), Order2:=xlAscending, Key3:=Range(sKey3), Order3:=xlSortOrder, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal

Range("C13").Select
End Sub


Sub ClearResult()
If Range("B14") <> "" Then

Range("B14").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection.Address).ClearContents
End If
End Sub

The code for Module1 is below:

Sub GetTab_Macro()

Dim wbCount As Long
Dim wbName, wbPathName As String
Dim i, j, iFile, FileCount, iRow, iRow1, iTotalRow, iTotalRow1 As Integer

Application.DisplayAlerts = False

Windows("MACRO_VIP.xlsm").Activate


FileCount = Worksheets("File Manager").Range("I11").Value

Sheets("Master_Wireless Cell Site Info").Select
Range("A2:BO800000").Select
Selection.ClearContents


'wbCount = 0
iTotalRow = 0
iTotalRow1 = 0


For iFile = 1 To FileCount

wbName = Worksheets("File Manager").Range("C" & iFile + 13).Value
wbPathName = Worksheets("File Manager").Range("D" & iFile + 13).Value


'Open each workbook
Application.DisplayAlerts = False
ActiveWindow.Visible = False
Workbooks.Open Filename:=wbPathName, UpdateLinks:=False

Sheets("Wireless Cell Site Info").Select

iRow = 0

'800,000 represents total how many rows can be copied

For j = 1 To 800000
If Workbooks(wbName).Worksheets("Wireless Cell Site Info").Range("D" & (1 + j)).Value <> "" Then
iRow = iRow + 1
Else
Exit For
End If
Next j



Sheets("Wireless Cell Site Info").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:BO500").Select
Application.CutCopyMode = False
Selection.Copy


Windows("Macro_VIP.xlsm").Activate
Sheets("Master_Wireless Cell Site Info").Select

Range("A" & iTotalRow + 2).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

iTotalRow = iTotalRow + iRow

Sheets("File Manager").Select

Workbooks(wbName).Activate
ActiveWorkbook.Close

Next iFile

End Sub

The code on Sheet1 (File Manager) is below:

Private Sub btnBrowse_Click()
On Error GoTo err

Application.FileDialog(msoFileDialogFolderPicker).Show

Sheet1.txtPath.Text = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems.Item(1)

err:
Exit Sub
End Sub
Private Sub btnFetchFiles_Click()

iRow = 14
fPath = Sheet1.txtPath.Text
If fPath <> "" Then

Set FSO = New Scripting.FileSystemObject
If FSO.FolderExists(fPath) <> False Then
Set SourceFolder = FSO.GetFolder(fPath)


If Sheet1.chkBoxIsSubFolder.Value = True Then
IsSubFolder = True
Else
IsSubFolder = False
If SourceFolder.Files.Count = 0 Then
MsgBox "No files exists in this Folder" & vbNewLine & vbNewLine & "Check your folder path and Try Again !!", vbInformation, "File Manager - LearnExcelMacro.com"
Exit Sub
End If
End If

Call ClearResult
Call ListFilesInFolder(SourceFolder, IsSubFolder)
lblFCount.Caption = iRow - 14

Else
MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!", vbInformation, "File Manager - LearnExcelMacro.com"
End If
Else
MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & "", vbInformation, "File Manager - LearnExcelMacro.com"
End If
Range("I11").Value = lblFCount.Caption
End Sub
Private Sub ComboBox1_Change()

Select Case (ComboBox2.Value)

Case "Ascending"

If ComboBox1.Value = "File Name" Then

Call ResultSorting(xlAscending, "C14", "E14", "G14")

End If
If ComboBox1.Value = "File Type" Then

Call ResultSorting(xlAscending, "F14", "E14", "C14")

End If
If ComboBox1.Value = "File Size" Then

Call ResultSorting(xlAscending, "E14", "C14", "G14")

End If
If ComboBox1.Value = "Last Modified" Then

Call ResultSorting(xlAscending, "G14", "C14", "E14")

End If


Case "Descending"

If ComboBox1.Value = "File Name" Then

Call ResultSorting(xlDescending, "C14", "E14", "G14")

End If
If ComboBox1.Value = "File Type" Then

Call ResultSorting(xlDescending, "F14", "E14", "C14")

End If
If ComboBox1.Value = "File Size" Then

Call ResultSorting(xlDescending, "E14", "C14", "G14")

End If
If ComboBox1.Value = "Last Modified" Then

Call ResultSorting(xlDescending, "G14", "C14", "E14")

End If

Case Default
Exit Sub

End Select

End Sub
Private Sub ComboBox2_Change()

Select Case (ComboBox2.Value)

Case "Ascending"

If ComboBox1.Value = "File Name" Then

Call ResultSorting(xlAscending, "C14", "E14", "G14")

End If
If ComboBox1.Value = "File Type" Then

Call ResultSorting(xlAscending, "F14", "E14", "C14")

End If
If ComboBox1.Value = "File Size" Then

Call ResultSorting(xlAscending, "E14", "C14", "G14")

End If
If ComboBox1.Value = "Last Modified" Then

Call ResultSorting(xlAscending, "G14", "C14", "E14")

End If

Case "Descending"

If ComboBox1.Value = "File Name" Then

Call ResultSorting(xlDescending, "C14", "E14", "G14")

End If
If ComboBox1.Value = "File Type" Then

Call ResultSorting(xlDescending, "F14", "E14", "C14")

End If
If ComboBox1.Value = "File Size" Then

Call ResultSorting(xlDescending, "E14", "C14", "G14")

End If
If ComboBox1.Value = "Last Modified" Then

Call ResultSorting(xlDescending, "G14", "C14", "E14")

End If

Case Default
Exit Sub

End Select


End Sub
Private Sub ComboBox2_DropButt*******()
If ComboBox2.ListCount = 0 Then
ComboBox2.AddItem ("Ascending")
ComboBox2.AddItem ("Descending")
ComboBox2.Value = "Ascending"
End If
End Sub
Private Sub ComboBox1_DropButt*******()
If ComboBox1.ListCount = 0 Then
ComboBox1.AddItem ("File Name")
ComboBox1.AddItem ("File Type")
ComboBox1.AddItem ("File Size")
ComboBox1.AddItem ("Last Modified")
ComboBox1.Value = "File Name"
End If
End Sub

Private Sub lblFCount_Click()
End Sub

Any help is appreciated.

Thanks

 

[Crystalyzer]

For each of the sheets you want to set

AutoFilterMode = False
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">FreezePanes = False</code>

 

[manjarigoyal]

I tried to use this earlier with and without ActiveWindow. but it's not working. I added these below
'Open each workbook
Application.DisplayAlerts = False
ActiveWindow.Visible = False

AutoFilterMode = False
FreezePanes =False

Workbooks.Open Filename:=wbPathName, UpdateLinks:=False


Sheets("Wireless Cell Site Info").Select

iRow = 0



For j = 1 To 800000
If Workbooks(wbName).Worksheets("Wireless Cell Site Info").Range("D" & (1 + j)).Value <> "" Then
iRow = iRow + 1
Else
Exit For
End If
Next j

 

[Crystalyzer]

I believe you need to specify the worksheet along with the method

ws.Autofiltermode = False
ws.FreezePanes = False

ws above is a worksheet variable so you can pass the different sheets to it.