asked on

Help with Excel VBA to sorts on mulitple keys

Hello,

I have been trying to get this sort to work for a few days but every thing i have tried has not worked. If i record a macro to do the sort it works fine but...when the code is combined with the rest of the process it will not work.

Thanks for your time
Gary

Private Sub CommandButton1_Click()
  Dim FileLength As Long
  Dim FileCount As Long
  Dim Cell As String
  Dim FileRange As String
  
  Application.ScreenUpdating = False
    Sheets(2).Select
    FileLength = ActiveSheet.UsedRange.Rows.Count + 1 'cell counts the number of linse that need to be copied to word.
    FileRange = ActiveSheet.[O1].Text 'target cell contains a formula to compose range (= "A3:D" & I1) the result would be something like A3:D463
    FileCount = 3

     Sheets(3).Select
        Sheets(3).Range("B:D").Select
        Selection.Copy
        Sheets(2).Select
        Sheets(2).Range("A:A").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
          
    For I = FileCount To FileLength
      Cell = Sheets(2).Range("A" & I).Text
        Sheets(2).Range("E2:M2").Copy 'contains formulas the will be copied to active rows
        Sheets(2).Range("E" & I).Select 'selects the next active row
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False 'pastes the formulas
    Next I
          
        Sheets(2).Range("J:J").Select
        Selection.Copy
        Sheets(2).Range("D:D").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
        
        Sheets(2).Range(FileRange).Select 'this does select the desired range to be sorted
        
        'the code bellow will run if it is run as a stand alone macro. but when added to this script
        '  it no longer works.
        
        Selection.Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("E3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
end sub

Open in new window

Impact-testing-2011-05a.xls

nutsch

How about this update on your sort.

Sheets(2).Range(FileRange).Sort Key1:=4, Order1:=xlAscending, Key2:=5 _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

Open in new window

nutsch

But basically you're trying to sort on the 5th column of a range with 4 columns, which is an issue anyway you code it.

Update Utility!O1 and suddenly, it works better.

But your code is good, your range is wrong.

        Sheets(2).Range(FileRange).Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("E3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

Open in new window

Thomas

Gary-Work

ASKER

I'm sorry i still can not get it to work.

the range is set to A3:D464

I changed the sort keys but still not working.

Sheets(2).Range(FileRange).Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("A3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

Open in new window

nutsch

I have copied your code, with the latest sort (see below) in a module of your sample file and ran it.
I don't get any errors. What is the issue you encounter?

Thomas

Private Sub CommandButton1_Click()
  Dim FileLength As Long
  Dim FileCount As Long
  Dim Cell As String
  Dim FileRange As String
  
  Application.ScreenUpdating = False
    Sheets(2).Select
    FileLength = ActiveSheet.UsedRange.Rows.Count + 1 'cell counts the number of linse that need to be copied to word.
    FileRange = ActiveSheet.[O1].Text 'target cell contains a formula to compose range (= "A3:D" & I1) the result would be something like A3:D463
    FileCount = 3

     Sheets(3).Select
        Sheets(3).Range("B:D").Select
        Selection.Copy
        Sheets(2).Select
        Sheets(2).Range("A:A").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
          
    For I = FileCount To FileLength
      Cell = Sheets(2).Range("A" & I).Text
        Sheets(2).Range("E2:M2").Copy 'contains formulas the will be copied to active rows
        Sheets(2).Range("E" & I).Select 'selects the next active row
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False 'pastes the formulas
    Next I
          
        Sheets(2).Range("J:J").Select
        Selection.Copy
        Sheets(2).Range("D:D").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
        
        Sheets(2).Range(FileRange).Select 'this does select the desired range to be sorted
        
        'the code bellow will run if it is run as a stand alone macro. but when added to this script
        '  it no longer works.
        
        Selection.Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("a3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
End Sub

Open in new window

Gary-Work

ASKER

ASKER CERTIFIED SOLUTION

nutsch

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

Gary-Work

ASKER

Outstanding work done very quickly

Gary-Work

ASKER

Thanks so much. your solution was perfect.

I was pulling my hair out on this problem for a while. The best part is I understand what the fix did.

nutsch

Glad to help, thanks for the grade. FYI, I've trimmed some of your code, this might be helpful as a reference.

Thomas

Private Sub CommandButton1_Click()
  Dim FileLength As Long
  Dim FileCount As Long
  Dim Cell As String
  Dim FileRange As String
  
Application.ScreenUpdating = False
    
With Sheets(2)
    
    .Select
    FileLength = .UsedRange.Rows.Count + 1 'cell counts the number of linse that need to be copied to word.
    FileRange = .[O1].Text 'target cell contains a formula to compose range (= "A3:D" & I1) the result would be something like A3:D463
    FileCount = 3

    
     Sheets(3).Range("B:D").Copy
     .Range("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
          
    For I = FileCount To FileLength
      Cell = .Range("A" & I).Text
        .Range("E2:M2").Copy 'contains formulas the will be copied to active rows
        .Range("E" & I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False 'pastes the formulas
    Next I
          
        .Range("J:J").Copy
        .Range("D:D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
        
        'the code below will run if it is run as a stand alone macro. but when added to this script
        '  it no longer works.
        
        .Range(FileRange).Sort Key1:=.Range("D3"), Order1:=xlAscending, Key2:=.Range("A3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        
End With


Application.ScreenUpdating = True
End Sub

Open in new window