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:
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: