manjarigoyal
New Member
- Joined
- Oct 28, 2015
- Messages
- 2
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
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