Hi,
I'm a complete newbie/dunce with VBA, so hope you will bear with me. A few months back, I posted asking for help with an advanced filter and a member (I think it was Jaslake?) provided me with some code. I now need to make some alterations to the workbook I am using it in, so I am back to beg for help again. The code I am currently using is as follows:
Option Explicit
Sub Do_Stuff()
Dim LR As Long
Dim Rng As Range
Dim Cell As Range
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
Sheets("Master timetable").Cells.Copy
ActiveSheet.Range("A1").PasteSpecial
Call UnMergeCells
With Sheets("Data sheet")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
ActiveWorkbook.Names.Add Name:="Areas", RefersTo:= _
.Range("$A$31:$A" & LR)
End With
Set Rng = Range("Areas")
For Each Cell In Rng
With Sheets("Temp")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
.AutoFilterMode = False
.Range("G2:G" & LR).AutoFilter Field:=1, Criteria1:="=All", _
Operator:=xlOr, Criteria2:=Cell.Value
If WorksheetExists(Cell.Value, ActiveWorkbook) Then
Sheets(Cell.Value).Cells.Clear
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(Cell.Value).Range("A1").PasteSpecial
Sheets(Cell.Value).Cells.WrapText = False
Sheets(Cell.Value).Cells.Columns.AutoFit
Else
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Cell.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(Cell.Value).Range("A1").PasteSpecial
Sheets(Cell.Value).Cells.WrapText = False
Sheets(Cell.Value).Cells.Columns.AutoFit
End If
If WorksheetExists(Cell.Value, ActiveWorkbook) Then
Sheets(Cell.Value).Cells.Clear
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(Cell.Value).Range("A1").PasteSpecial
Sheets(Cell.Value).Cells.WrapText = False
Sheets(Cell.Value).Cells.Columns.AutoFit
Sheets(Cell.Value).Columns("N:N").EntireColumn.Hidden = True
Else
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Cell.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(Cell.Value).Range("A1").PasteSpecial
Sheets(Cell.Value).Cells.WrapText = False
Sheets(Cell.Value).Cells.Columns.AutoFit
Sheets(Cell.Value).Columns("N:N").EntireColumn.Hidden = True
End If
.AutoFilterMode = False
End With
Next Cell
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub UnMergeCells()
' From http://www.excelforum.com/excel-prog...th-values.html
Dim oneCell As Range, onesFriends As Range
With ThisWorkbook.Sheets("Temp")
For Each oneCell In .UsedRange
If oneCell.MergeCells Then
Set onesFriends = oneCell.MergeArea
oneCell.UnMerge
onesFriends.Value = oneCell.Value
End If
Next oneCell
End With
End Sub
Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function
What I now need is as follows:
1. Each of the resulting worksheets for this filter to display only the data from the following columns: A, C, D, E, F, I, K, L & M
2. For columns L&M, I want the filter-generated sheets to display only the values in these columns, not the formulae that are contained in them on the original Master Timetable sheet.
As an aside, I think I could also lose the code related to unmerging cells, as there are no longer any merged cells in the workbook. I just wasn't sure how much/what to delete.
Many thanks in advance for any help
Bookmarks