VBA help

MZING81

New member
Joined
Mar 27, 2012
Messages
40
Reaction score
0
Points
0
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.

Code:
[FONT=Calibri][SIZE=3][COLOR=#000000] SUB MREPORT[/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Calibri]Application.ScreenUpdating = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Application.Calculation = xlCalculationManual[/FONT][/COLOR][/SIZE]


[SIZE=3][COLOR=#000000][FONT=Calibri]      ' unmergenew Macro[/FONT][/COLOR][/SIZE]

[FONT=Calibri][SIZE=3][COLOR=#000000]For Each WS In Worksheets[/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Calibri]        With WS.UsedRange[/FONT][/COLOR][/SIZE]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.WorksheetFunction.Application.Goto Reference:="R1C1"[/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Selection.UnMerge[/FONT][/COLOR][/SIZE]

[FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Calibri]      Next WS[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Calibri]' filtersort Macro[/FONT][/COLOR][/SIZE]


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

[FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]




[SIZE=3][COLOR=#000000][FONT=Calibri]'Remove head count data macro[/FONT][/COLOR][/SIZE]


[SIZE=3][COLOR=#000000][FONT=Calibri]        With WS.UsedRange[/FONT][/COLOR][/SIZE]

[FONT=Calibri][SIZE=3][COLOR=#000000]Application.WorksheetFunction.Cells.Find(What:="actual:", After:=ActiveCell, LookIn:=xlFormulas, lookat _[/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Calibri]        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]        False, SearchFormat:=False).Activate[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Rows.Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Selection.Delete Shift:=xlUp[/FONT][/COLOR][/SIZE]

[FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]


[SIZE=3][COLOR=#000000][FONT=Calibri]'Remergeonly Macro[/FONT][/COLOR][/SIZE]


[SIZE=3][COLOR=#000000][FONT=Calibri]        With WS.UsedRange[/FONT][/COLOR][/SIZE]

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

[FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]


[SIZE=3][COLOR=#000000][FONT=Calibri]    Dim FoundCell As Range[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Dim FirstAddress As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Dim PrevAddress As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Dim CurrAddress As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Dim SearchTerm As String[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Calibri]    SearchTerm = "Manning Check Report"[/FONT][/COLOR][/SIZE]

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

[SIZE=3][COLOR=#000000][FONT=Calibri]  Application.ScreenUpdating = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Application.Calculation = xlCalculationAutomatic[/FONT][/COLOR][/SIZE]

[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

Any help would be greatly appreciated

MZING81
 
Hi there,

I haven't had a ton of time to work on this, but this will take you part way there:
Code:
    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.
 
Ken,
You need to qualify Range("D8") in this line:
Code:
[LEFT][COLOR=#333333].SortFields.Add Key:=Range("D8"), _

i.e. it should be:
Code:
[/COLOR][COLOR=#333333].SortFields.Add Key:=ws.Range("D8"), _
[/COLOR]


[/LEFT]
 
Additions

Code:
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
                [COLOR=#ff0000]With .Sort
[/COLOR]                    .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
 
Try this:

Code:
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!
 
Back
Top