PDA

View Full Version : Solved: Report to collect filtered data from multiple sheets and consolidate



aloy78
08-06-2012, 11:00 PM
Dear all,

This module used to work for me. But somehow after I have change the data range to "table" and add in a few addition columns of data, an error appear on the module.


Sub All_Incoming()
Dim awb As Workbook
Dim sht As Worksheet, ws As Worksheet, wsIAir As Worksheet, wsISea As Worksheet, wsILan As Worksheet
Dim rngIAir As Range, rngISea As Range, rngILan As Range, rngCell As Range
Dim newWsName As String
Set awb = ThisWorkbook
newWsName = "Received Today"
For Each sht In awb.Worksheets
If UCase(sht.Name) = UCase(newWsName) Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
End If
Next
Set wsIAir = Worksheets("Imp-Air")
Set wsISea = Worksheets("Imp-Sea")
Set wsILan = Worksheets("Imp-Lan")
wsIAir.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = newWsName
Set ws = Worksheets("Received Today")
With ws
.Range("B2") = "Received Today"
.ShowAllData ' <- ERROR APPEARED HERE
.Cells.Hyperlinks.Delete
.Cells.ClearComments
.Range("15:17").Cells.ClearContents
'.Range("b16:be16").Interior.Color = RGB(127, 127, 127)
.Range("4:14,19:" & Range("B1048576").End(xlUp).Row).EntireRow.Delete
End With
'==========
'below is from: http://www.ozgrid.com/forum/showthread.php?t=23611&page=1
With wsIAir
.Range("A:ZZ").EntireColumn.Hidden = False ' show all hidden column from master sheet
.AutoFilterMode = False
.Range("B18:Bm18").AutoFilter
.Range("B18:Bm18").AutoFilter Field:=2, Criteria1:="cleared"
Set rngIAir = .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
'set a range = to visible cells (excluding the header)
rngIAir.Copy Destination:=ws.Range("B1048576").End(xlUp).Offset(1, 0)
End With

With wsISea
.Range("A:ZZ").EntireColumn.Hidden = False ' show all hidden column from master sheet
.AutoFilterMode = False
.Range("B18:Bm18").AutoFilter
.Range("B18:Bm18").AutoFilter Field:=2, Criteria1:="cleared"
Set rngISea = .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
'set a range = to visible cells (excluding the header)
rngISea.Copy Destination:=ws.Range("B1048576").End(xlUp).Offset(1, 0)
End With

With wsILan
.Range("A:ZZ").EntireColumn.Hidden = False ' show all hidden column from master sheet
.AutoFilterMode = False
.Range("B18:Bm18").AutoFilter
.Range("B18:Bm18").AutoFilter Field:=2, Criteria1:="cleared"
Set rngILan = .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
'set a range = to visible cells (excluding the header)
rngILan.Copy Destination:=ws.Range("B1048576").End(xlUp).Offset(1, 0)
End With

' REMOVE LINKS & COMMENTS & VALIDATIONS
ws.Cells.Hyperlinks.Delete
ws.Cells.ClearComments
ws.Cells.Validation.Delete

' REMOVING OF CERTAIN COLUMNS
ws.Range("d:f,h:h,k:k,o:o,s:ai,al:al,an:ap,ar:bz").EntireColumn.Delete
ws.Move

' REMOVING ALL MACROS IN THE NEW WORKSHEET [http://www.vbaexpress.com/kb/getarticle.php?kb_id=93]
Dim x As Integer
On Error Resume Next
With ActiveWorkbook.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With

' SAVE WORKBOOK AS
Application.Dialogs(xlDialogSaveAs).Show

' RETURN TO ORIGINAL WORKSHEET AND GO TO SHEET 1
awb.Activate
Sheets(1).Select
awb.Activate
Set wsIAir = Nothing
Set wsISea = Nothing
Set wsILan = Nothing
Set ws = Nothing
Set rngIAir = Nothing
Set rngISea = Nothing
Set rngILan = Nothing
'Application.WindowState = xlMinimized
'awb = xlMinimized
End Sub



Been tweaking it from the original but to no success. :banghead:

Tinbendr
08-09-2012, 06:32 AM
It's part of AutoFilter.

In order for ShowAllData to work, autofilter has to be on and filtered.

We just have to test for that.

With ws
.Range("B2") = "Received Today"
If .AutoFilterMode And .FilterMode Then
.ShowAllData
End If
.Cells.Hyperlinks.Delete
.Cells.ClearComments
.Range("15:17").Cells.ClearContents
'.Range("b16:be16").Interior.Color = RGB(127, 127, 127)
.Range("4:14,19:" & Range("B1048576").End(xlUp).Row).EntireRow.Delete
End With


More info on AutoFilter. (http://www.ozgrid.com/VBA/autofilter-vba.htm)

aloy78
08-12-2012, 05:33 PM
Hi David,

I've tested the code that you have provided. Now the error goes to the other line.




With ws
.Range("B2") = "Received Today"
If .AutoFilterMode And .FilterMode Then
.ShowAllData
End If
.Cells.Hyperlinks.Delete
.Cells.ClearComments
.Range("15:17").Cells.ClearContents
'.Range("b16:be16").Interior.Color = RGB(127, 127, 127)
.Range("4:14,19:" & Range("B1048576").End(xlUp).Row).EntireRow.Delete ' Error message
End With

aloy78
08-13-2012, 01:08 AM
Hi David,

I managed to tweak around and get the module to run. It has something to do with table (ListObjects) :)

So I add in a line called:
ListObjects().Unlist

However when I try to convert the range backed into a table. It didn't do what I wanted it to.



Sub All_incoming()

' I removed the earlier part of the module
' This part onwards I try to convert the range back into a table

With wsIAir
.Range("A:ZZ").EntireColumn.Hidden = False ' show all hidden column from master sheet
.AutoFilterMode = False
.Range("B18:Bm18").AutoFilter

' List objects doesnt do what it is supposed to. <---
.ListObjects.Add(xlSrcRange, Range([B18].End(xlDown), [B18].End(xlToRight)), , xlYes).Name = "TableA"
End With

With wsISea
.Range("A:ZZ").EntireColumn.Hidden = False ' show all hidden column from master sheet
.AutoFilterMode = False
.Range("B18:Bm18").AutoFilter
.ListObjects.Add(xlSrcRange, Range([B18].End(xlDown), [B18].End(xlToRight)), , xlYes).Name = "TableS"
End With

With wsILan
.Range("A:ZZ").EntireColumn.Hidden = False ' show all hidden column from master sheet
.AutoFilterMode = False
.Range("B18:Bm18").AutoFilter
.ListObjects.Add(xlSrcRange, Range([B18].End(xlDown), [B18].End(xlToRight)), , xlYes).Name = "TableL"
End With

' RETURN TO ORIGINAL WORKSHEET AND GO TO SHEET 1
awb.Activate
Sheets(1).Select
awb.Activate
Set wsIAir = Nothing
Set wsISea = Nothing
Set wsILan = Nothing
Set ws = Nothing
Set rngIAir = Nothing
Set rngISea = Nothing
Set rngILan = Nothing
'Application.WindowState = xlMinimized
'awb = xlMinimized
End Sub

aloy78
08-14-2012, 12:33 AM
Dear all,

I managed to get it to work. :hi:

Here is a working sample for those who are interested to try.