VBA help

[MZING81]

Hi New with VBA,

I've spent some time trying to get his macro to work. There are few issues that I cant get around. This macro needs to work across all the workshhets in the workbook, but only portion funcitons. Also some this code is taken from macro's that I recorded that worked fine indivually but not as a whole. The other error is the AutoFilter portion. I get an error that stating an issue with the method.

 SUB MREPORT
Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


      ' unmergenew Macro

For Each WS In Worksheets
        With WS.UsedRange
Application.WorksheetFunction.Application.Goto Reference:="R1C1"
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.UnMerge

End With
      Next WS

' filtersort Macro


For Each WS In Worksheets
        With WS.UsedRange
 Application.WorksheetFunction.Application.Goto Reference:="R8C1"
    Rows("8:8").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets.AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets.AutoFilter.Sort.SortFields.Add Key:=Range("D8"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
      xlSortNormal
    With ActiveWorkbook.Worksheets.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

End With




'Remove head count data macro


        With WS.UsedRange

Application.WorksheetFunction.Cells.Find(What:="actual:", After:=ActiveCell, LookIn:=xlFormulas, lookat _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Rows.Select
    Selection.Delete Shift:=xlUp

End With


'Remergeonly Macro


        With WS.UsedRange

    Columns("A:C").Select
    Selection.Merge True
    Columns("K:L").Select
    Selection.Merge True
Application.WorksheetFunction.Application.Goto Reference:="R1C16"
    Selection.Copy
  Application.WorksheetFunction.Application.Goto Reference:="R3C7"
    ActiveSheet.Paste
    Range("G1:J3").Select
   Application.WorksheetFunction.Application.CutCopyMode = False
    Selection.Merge True
    Range("F1:J3").Select
    Selection.Merge True
    Range("F3:J3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
  Columns("O:P").Select
    Selection.Merge True

End With


    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim PrevAddress As String
    Dim CurrAddress As String
    Dim SearchTerm As String

    SearchTerm = "Manning Check Report"

    With Columns("G:K")
        Set FoundCell = .Find(SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not FoundCell Is Nothing Then
            FoundCell.Name = "FirstAddress"
            Do
                PrevAddress = FoundCell.Address
                FoundCell.Resize(3).EntireRow.Insert
                ActiveSheet.HPageBreaks.Add before:=Range(PrevAddress)
                Set FoundCell = .FindNext(FoundCell)
            Loop While FoundCell.Address <> Range("FirstAddress").Address
        Else
            MsgBox "No search term found...", vbExclamation
        End If

  Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Any help would be greatly appreciated

MZING81

[Ken Puls]

Hi there,

I haven't had a ton of time to work on this, but this will take you part way there:

    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


    For Each ws In Worksheets
        With ws
            .UsedRange.UnMerge
            .Rows("8:8").AutoFilter
            With .AutoFilter
                With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=Range("D8"), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:= _
                        xlSortNormal
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End With
        End With
    Next ws


''Remove head count data macro

One of the biggest issues we face in this is that we have to mock up data to work through it. If you could post a workbook (double click the "Reply" button to go to the advanced editor), that would be a BIG help and let us focus on your code rather than guessing at your data structure.

[JoePublic]

Ken,
You need to qualify Range("D8") in this line:

.SortFields.Add Key:=Range("D8"), _

i.e. it should be:

.SortFields.Add Key:=ws.Range("D8"), _

[MZING81]

Sub filter()
 
  Dim ws As Worksheet
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each ws In Worksheets
        With ws
            .UsedRange.UnMerge
            .Rows("8:8").AutoFilter
            With .AutoFilter
                With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=ws.Range("D8"), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:= _
                        xlSortNormal
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                  Application.Goto Reference:="R8C1"
    Rows("8:8").Select
    Selection.AutoFilter
                End With
            End With
        End With
    Next ws
 

End Sub

So I have updated the code a little bit, it works across all the sheets, but I get a runtime error:91 Object variable not set, I need it to remove the filter so that I can remerge the sheet properly. I appreciate the help.


I just need one more portion of the code to function and that should be it. Just need it too remerge across all the worksheets it will on work on the active.

Thanx

MZING81

[Ken Puls]

Try this:

Sub filter() 
  Dim ws As Worksheet
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


    For Each ws In Worksheets
        Debug.Print ws.Name
        With ws
            .UsedRange.UnMerge
            .Rows("8:8").AutoFilter
            With .AutoFilter
                With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=ws.Range("D8"), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:= _
                        xlSortNormal
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End With
            .AutoFilterMode = False
        End With
    Next ws
End Sub

PS, Thanks for picking up my error Joe!