?
Solved

Excel 2007 vba sort

Posted on 2012-09-13
11
Medium Priority
?
552 Views
Last Modified: 2012-09-13
Hello,
I import my data from SQL  to Excel sheet1 (Import),
is there any VBA code I can run to sort it as in Sheet2 (File).

Note,
Group 1, From Column "A", Row 7 to Row 75
Group 2, From Column "G", from Row 7 to Row ---

Please see attached.

your help is appreciated.
Sample.xlsx
0
Comment
Question by:W.E.B
  • 4
  • 4
  • 3
11 Comments
 
LVL 5

Expert Comment

by:KyleSW
ID: 38395120
I'd do it with 2 pivot tables, with ToZone in the Row Labels, Name in the Column labels and Price in the Values field

Would that work for you?
----Sample.xlsx
0
 
LVL 11

Expert Comment

by:ScriptAddict
ID: 38395164
Absolutely.  The code would look something like this:


Range("A:D").Sort Key1:=Range("A1"), Order1:=xlDescending, Key2:=Range("B2") _
        , Order2:=xlYes, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom

Open in new window


However, what are you planning to do with this information once you have it looking like the spreadsheet on #2?
0
 
LVL 5

Expert Comment

by:KyleSW
ID: 38395195
@scriptAddict  - have you tried that code and compared it to the desired output? ;)
0
Technology Partners: 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!

 

Author Comment

by:W.E.B
ID: 38395397
Hello,
the idea is,
I will add a button to Excel sheet, assign macro to it, (linked to my SQL database) (this part is done)
Sales people will use the excel, macro button to get the prices from my database, hit another button to get the data sorted properly (on a company template),
save/print/ send to client.
0
 
LVL 5

Expert Comment

by:KyleSW
ID: 38395403
Why not pivot the data in the SQL query?

Seems like a more elegant solution, will be faster too :)
0
 
LVL 11

Expert Comment

by:ScriptAddict
ID: 38395615
Kyle, obviously the code didn't do what he wanted, but I wanted to figure out if he would be happy with a pivot table, or if he needed his exact format for other reasons.  

Here is the code you need Wass_QV  It should work as long as your tab is named "Import".  It doesn't rename the finished tab "file"  If you need that let me know and I'll add it.

Sub Sort()
'
' Sort Macro
'
' Keyboard Shortcut: Ctrl+Shift+V
'
Dim WS As Worksheet
Dim TL As Range
Dim CL As Range
Dim CR As Range
Dim DR As Integer
Dim DC As Integer



    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Import").Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Set WS = Sheets.Add

WS.Range("A7").Value = "ToZone"
WS.Range("B7").Value = "ECO"
WS.Range("C7").Value = "REG"
WS.Range("D7").Value = "RUSH"
WS.Range("E7").Value = "DIR"

WS.Range("G7").Value = "ToZone"
WS.Range("H7").Value = "ECO"
WS.Range("I7").Value = "REG"
WS.Range("J7").Value = "RUSH"
WS.Range("K7").Value = "DIR"
WS.Range("A7:K7").Font.Bold = True

Set TL = Worksheets("Import").Range("A:D")

For Each CL In TL.Rows
    'MsgBox CL.Address
    If Worksheets("Import").Range("A" & CL.Row) <> "Name" Then
    If Worksheets("Import").Range("A" & CL.Row) = "" Then GoTo Done
    
        Set CR = Worksheets("Import").Range("A" & CL.Row)
        DR = CR.Offset(0, 2).Value + 7
        Select Case CR.Text
            Case "ECO"
            DC = 1
            Case "REG"
            DC = 2
            Case "RUSH"
            DC = 3
            Case "DIR"
            DC = 4
        End Select
        If CR.Offset(0, 2) > 68 Then
            DR = DR - 68
            WS.Range("G" & DR).Value = CR.Offset(0, 2)
            WS.Range("G" & DR).Offset(0, DC).Value = CR.Offset(0, 3).Value
        Else
            WS.Range("A" & DR).Value = CR.Offset(0, 2)
            WS.Range("A" & DR).Offset(0, DC).Value = CR.Offset(0, 3).Value
        End If
    End If
Next

Done:
Range("B8:E75,H8:K75").NumberFormat = "$#,##0.00"

End Sub

Open in new window

0
 
LVL 11

Expert Comment

by:ScriptAddict
ID: 38395651
Here is the code to rename the output tab to file  Just insert it under the Done: in the code above.

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("File").Delete
On Error GoTo 0
Application.DisplayAlerts = True
WS.Name = "File"

Open in new window

0
 

Author Comment

by:W.E.B
ID: 38395664
ScriptAddict,
This is great,

2 Small things,
Are you able to save it to Sheet2 (File), this is where I have the company template.
Are you able to  center the data

Much much appreciated.
0
 
LVL 11

Accepted Solution

by:
ScriptAddict earned 1200 total points
ID: 38395710
I always try and completely recreate the tab.  People rename and screw things up in a variety of ways, and if I rebuild the tab entirely it eliminates those problems.  However It is easy to simply update the tab.  

here is the updated code per your requests

Sub Sort()
'
' Sort Macro
'
' Keyboard Shortcut: Ctrl+Shift+V
'
Dim WS As Worksheet
Dim TL As Range
Dim CL As Range
Dim CR As Range
Dim DR As Integer
Dim DC As Integer



    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Import").Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Set WS = Worksheets("File") 'Sheets.Add

WS.Range("A7").Value = "ToZone"
WS.Range("B7").Value = "ECO"
WS.Range("C7").Value = "REG"
WS.Range("D7").Value = "RUSH"
WS.Range("E7").Value = "DIR"

WS.Range("G7").Value = "ToZone"
WS.Range("H7").Value = "ECO"
WS.Range("I7").Value = "REG"
WS.Range("J7").Value = "RUSH"
WS.Range("K7").Value = "DIR"
WS.Range("A7:K7").Font.Bold = True

Set TL = Worksheets("Import").Range("A:D")

For Each CL In TL.Rows
    'MsgBox CL.Address
    If Worksheets("Import").Range("A" & CL.Row) <> "Name" Then
    If Worksheets("Import").Range("A" & CL.Row) = "" Then GoTo Done
    
        Set CR = Worksheets("Import").Range("A" & CL.Row)
        DR = CR.Offset(0, 2).Value + 7
        Select Case CR.Text
            Case "ECO"
            DC = 1
            Case "REG"
            DC = 2
            Case "RUSH"
            DC = 3
            Case "DIR"
            DC = 4
        End Select
        If CR.Offset(0, 2) > 68 Then
            DR = DR - 68
            WS.Range("G" & DR).Value = CR.Offset(0, 2)
            WS.Range("G" & DR).Offset(0, DC).Value = CR.Offset(0, 3).Value
        Else
            WS.Range("A" & DR).Value = CR.Offset(0, 2)
            WS.Range("A" & DR).Offset(0, DC).Value = CR.Offset(0, 3).Value
        End If
    End If
Next

Done:
ws.Range("B7:E75,H7:K75").HorizontalAlignment = xlCenter
ws.Range("B8:E75,H8:K75").NumberFormat = "$#,##0.00"

'Application.DisplayAlerts = False
'On Error Resume Next
'Worksheets("File").Delete
'On Error GoTo 0
'Application.DisplayAlerts = True
'WS.Name = "File"

End Sub

Open in new window


I'm not sure exactly what you mean by the data.  So I did everything in the range right under the Done:

If you want to edit that range, it's that line. (76)
0
 

Author Comment

by:W.E.B
ID: 38395781
Thank you very much
Well Done.
0
 

Author Closing Comment

by:W.E.B
ID: 38395786
Perfect,
thanks
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

840 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