none
Struggling with Macros, personal workbook problems RRS feed

  • Question

  • I tried creating a personal workbook macro, so that it would work across any new document, but every time I run it a problem arises.

    Apparently it's referencing the original document in which the macro was created and not running correctly in any new workbook.

    I've underscored the area which is the problem.

    Sub ONC_process()
    '
    ' ONC_process Macro
    ' Format ONC process
    '
    ' Keyboard Shortcut: Ctrl+m
    '
        Range("A:A,B:B,E:E,G:G").Select
        Range("G1").Activate
        Selection.Delete Shift:=xlToLeft
        Range("A:A,B:B,C:C").Select
        Range("C1").Activate
        Selection.ColumnWidth = 14.43
        Columns("C:C").Select
        Columns("C:C").EntireColumn.AutoFit
        Rows("22:22").Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
        Range("A2:B2,A21,A22,B22,A31").Select
        Range("A31").Activate
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Range("A2:C21").Select
        ActiveWorkbook.Worksheets("QueueDetail_20161118_103850").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("QueueDetail_20161118_103850").Sort.SortFields.Add _
            Key:=Range("C2:C21"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("QueueDetail_20161118_103850").Sort
            .SetRange Range("A2:C21")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Range("A22:C31").Select
        ActiveWorkbook.Worksheets("QueueDetail_20161118_103850").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("QueueDetail_20161118_103850").Sort.SortFields.Add _
            Key:=Range("C22:C31"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("QueueDetail_20161118_103850").Sort
            .SetRange Range("A22:C31")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        Range("G36").Select
    End Sub


    Friday, November 18, 2016 7:01 PM

All replies

  • Try replacing all occurrences of

    ActiveWorkbook.Worksheets("QueueDetail_20161118_103850")

    with

    ActiveSheet


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, November 18, 2016 7:06 PM
  • Thank you, extremely helpful, worked like a charm.

    This might sound strange, but I'm exporting a list, deleting unnecessary columns so that I really only have 3 left with data.

    These 3 columns are then broken into pages with 20 rows.

    The first and last row of each page are highlighted, then sorted from the data in column c (just a number, could be 1 through 120, numbers can repeat, they refer to a tray number on which specimens are located).

    I would like the code to recognize whether or not data is in a field. When I export the data to a new excel sheet there could be 500 rows of data or only 50, but right now the macro is "dumb" and obviously runs exactly through the cells I selected during the recording of the initial macro, but I would like it to be flexible to recognize and organize/sort what is necessary.

    Friday, November 18, 2016 7:27 PM
  • It's hard to guess what exactly you are trying to do, but see if this comes near. Please test on a copy of the worksheet.

    Sub ONC_process()
    '
    ' ONC_process Macro
    ' Format ONC process
    '
    ' Keyboard Shortcut: Ctrl+m
    '
        Dim r As Long
        Dim m As Long
        Application.ScreenUpdating = False
        Range("A:A,B:B,E:E,G:G").Delete Shift:=xlToLeft
        Range("A:C").ColumnWidth = 14.43
        Columns("C:C").EntireColumn.AutoFit
        m = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For r = 2 To m Step 20
            Range("A" & r).Resize(1, 2).Interior.Color = vbYellow
            If r > 2 Then
                ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A" & r)
            End If
            Range("A" & r).Resize(20, 3).Sort Key1:=Range("C" & r)
        Next r
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, November 18, 2016 8:48 PM