Results 1 to 5 of 5

Thread: VBA help

  1. #1

    VBA help



    Register for a FREE account, and/
    or Log in to avoid these ads!

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

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    1,730
    Articles
    76
    Blog Entries
    14
    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 Puls, CMA, MS MVP (Excel)

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    Super Moderator JoePublic's Avatar
    Join Date
    Sep 2011
    Location
    Askew
    Posts
    162
    Articles
    0
    Ken,
    You need to qualify Range("D8") in this line:
    Code:
    .SortFields.Add Key:=Range("D8"), _


    i.e. it should be:
    Code:
    .SortFields.Add Key:=ws.Range("D8"), _



    Circumference of a circle = 2πr²



    ²the circle's radius

  4. #4

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

  5. #5
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    1,730
    Articles
    76
    Blog Entries
    14


    Register for a FREE account, and/
    or Log in to avoid these ads!

    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!
    Ken Puls, CMA, MS MVP (Excel)

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •