Solved

Help with Excel VBA to sorts on mulitple keys

Posted on 2011-03-09
9
177 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:Gary-Work
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
9 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 35084952
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

0
 
LVL 39

Expert Comment

by:nutsch
ID: 35085045
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
0
 

Author Comment

by:Gary-Work
ID: 35085166
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

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 39

Expert Comment

by:nutsch
ID: 35085317
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

0
 

Author Comment

by:Gary-Work
ID: 35085413
screenshots of error
0
 
LVL 39

Accepted Solution

by:
nutsch earned 250 total points
ID: 35085487
Thanks, I was able to replicate the error with that. Update the sort code to

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

So it doesn't get lost on the range references b/n different sheets.

Thomas
0
 

Author Closing Comment

by:Gary-Work
ID: 35085564
Outstanding work done very quickly
0
 

Author Comment

by:Gary-Work
ID: 35085575
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.

0
 
LVL 39

Expert Comment

by:nutsch
ID: 35085648
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

0

Featured Post

MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

691 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question