Excel Create Sorted List based on other cells

Question

What I want to do is take my budget sheet and sort it in a specific order. Here is exactly what I have:

Column A = Name of item to be budgeted (bills and pays)

Column B = Day of the month that item is due.

Column C = Amount that item is for.

I want to create some VBA code that when a button is pressed it will take that information from those columns and order it by the day in Column B like this:

1 - PayDay - 1000
4 - Cell Phone - 75
5 - Mortgage - 1350

EDIT:

I had been working on this VBA. Just need to figure out how to put in the sort function so it orders my results by the day column.

Sub CreateList()

' Clear the current records
currentRow = 2
While currentRow < 200

    If IsEmpty(Worksheets("Jan").Cells(currentRow, 9)) Then
    GoTo Generate
    End If

    Worksheets("Jan").Cells(currentRow, 9).Value = ""
    Worksheets("Jan").Cells(currentRow, 10).Value = ""
    Worksheets("Jan").Cells(currentRow, 11).Value = ""
    Worksheets("Jan").Cells(currentRow, 12).Value = ""

    currentRow = currentRow + 1
Wend

Generate:

' Generate new list

titleCol = 1
dayCol = 2
amountCol = 3

currentListRow = 2

currentSheet = 1
While currentSheet < 2

    currentRow = 7
    cellVal = ""

    While currentRow < 800

    cellVal = Worksheets("Jan").Cells(currentRow, dayCol).Text

        If Not IsEmpty(cellVal) Then
            If Not cellVal = "0" Then
                If Not cellVal = "" Then
                If Not cellVal = "Due Date" Then

                    ' Set vals in list cells
                    Worksheets("Jan").Cells(currentListRow, 10).Value = Worksheets("Jan").Cells(currentRow, dayCol).Text
                    Worksheets("Jan").Cells(currentListRow, 9).Value = Worksheets("Jan").Cells(currentRow, titleCol).Text
                    Worksheets("Jan").Cells(currentListRow, 11).Value = Worksheets("Jan").Cells(currentRow, amountCol).Text


                    currentListRow = currentListRow + 1

        End If
        End If
        End If
        End If

        currentRow = currentRow + 1
    Wend

    currentSheet = currentSheet + 1
Wend

End Sub

Answer 1

With the help of whytheq, I came up with this solution. The first Sub copies the fields to a new area. The second sub sorts the newly created list by the day column. The third sub changes any of the newly created list items that aren't labeled as mine or my wifes name and makes them negative. I did this so I could add a field to the right of the new list that does the math associated to each list item adjusting the amount of money we have left after each bill is paid or each pay is added.

Option Explicit
Sub CreateList()

' Clear the current records
Dim currentRow  As Integer '<<always declare variables
currentRow = 2
While currentRow < 200 And Not IsEmpty(Worksheets("Jan").Cells(currentRow, 9)) '<<best to not use goto unless no other way of coding it

Worksheets("Jan").Cells(currentRow, 9).Value = ""
Worksheets("Jan").Cells(currentRow, 10).Value = ""
Worksheets("Jan").Cells(currentRow, 11).Value = ""

currentRow = currentRow + 1
Wend

' Generate new list
Dim titleCol As Integer, dayCol As Integer, amountCol As Integer, cellVal As String

Dim currentListRow As Integer, currentSheet As Integer

titleCol = 1
dayCol = 2
amountCol = 3

currentListRow = 3

currentSheet = 1
While currentSheet < 2

    currentRow = 7

    While currentRow < 800

    cellVal = Worksheets("Jan").Cells(currentRow, dayCol).Text

        If Not IsEmpty(cellVal) And Not cellVal = "0" And Not cellVal = "" And Not cellVal = "Due Date" Then

                    ' Set vals in list cells
                    Worksheets("Jan").Cells(currentListRow, 10).Value = Worksheets("Jan").Cells(currentRow, dayCol).Text
                     Worksheets("Jan").Cells(currentListRow, 9).Value = Worksheets("Jan").Cells(currentRow, titleCol).Text
                       Worksheets("Jan").Cells(currentListRow, 11).Value = Worksheets("Jan").Cells(currentRow, amountCol).Text
                       currentListRow = currentListRow + 1

        End If

        currentRow = currentRow + 1
    Wend

    currentSheet = currentSheet + 1
Wend
Call Sort
End Sub
Public Sub Sort()

Dim oneRange As Range
 Dim aCell As Range

Set oneRange = Range("I3:K40")
 Set aCell = Range("J3")

oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlGuess

Call Negative
End Sub
Public Sub Negative()
Dim titlesCol As Integer, daysCol As Integer, amountsCol As Integer, cellVal As String
Dim currentListRow As Integer, currentSheet As Integer, currentRow  As Integer

 titlesCol = 9
 amountsCol = 11
 currentListRow = 3

currentSheet = 1
While currentSheet < 2

    currentRow = 3
    cellVal = ""

    While currentRow < 41

    cellVal = Worksheets("Jan").Cells(currentRow, titlesCol).Text

             If Not cellVal = "Alisa" Then
                If Not cellVal = "Jordan" Then

                    ' Multiply by Negative 1
                    Worksheets("Jan").Cells(currentRow, 11).Value = Worksheets("Jan").Cells(currentRow, 11).Value * -1

                    currentListRow = currentListRow + 1

        End If
        End If

        currentRow = currentRow + 1
    Wend

    currentSheet = currentSheet + 1
Wend
 End Sub

Answer 2

Not answered your question but just had a quick look through your code and there are a couple of obvious improvements:

Option Explicit   '<<best to use this in all modules; 

Sub CreateList()

' Clear the current records
Dim currentRow  As Integer '<<always declare variables
currentRow = 2
While currentRow < 200 And Not IsEmpty(Worksheets("Jan").Cells(currentRow, 9)) '<<best to not use goto unless no other way of coding it

    Worksheets("Jan").Cells(currentRow, 9).Value = ""
    Worksheets("Jan").Cells(currentRow, 10).Value = ""
    Worksheets("Jan").Cells(currentRow, 11).Value = ""
    Worksheets("Jan").Cells(currentRow, 12).Value = ""

    currentRow = currentRow + 1
Wend


' Generate new list
Dim titleCol As Integer, dayCol As Integer, amountCol As Integer
Dim currentListRow As Integer, currentSheet As Integer

titleCol = 1
dayCol = 2
amountCol = 3

currentListRow = 2

currentSheet = 1
While currentSheet < 2

    currentRow = 7
    cellVal = ""

    While currentRow < 800

        cellVal = Worksheets("Jan").Cells(currentRow, dayCol).Text

        If Not IsEmpty(cellVal) And Not cellVal = "0" And Not cellVal = "" And Not cellVal = "Due Date" Then  '<<all conditions seem to be able to go in one IF

            ' Set vals in list cells
            Worksheets("Jan").Cells(currentListRow, 10).Value = Worksheets("Jan").Cells(currentRow, dayCol).Text
            Worksheets("Jan").Cells(currentListRow, 9).Value = Worksheets("Jan").Cells(currentRow, titleCol).Text
            Worksheets("Jan").Cells(currentListRow, 11).Value = Worksheets("Jan").Cells(currentRow, amountCol).Text
            currentListRow = currentListRow + 1

        End If

    currentRow = currentRow + 1
    Wend

currentSheet = currentSheet + 1
Wend

Call SortByDescription

End Sub

Public Sub SortByDescription()
Dim Rng As Range, Ws As Excel.Worksheet, LastRow As Long
    Set Ws = ThisWorkbook.ActiveSheet
    Set Rng = Ws.Range("A1")
    Ws.Range(Rng, Rng.End(xlToRight)).Select
    Set Rng = Ws.Range(Selection, Selection.End(xlDown))
    LastRow = Rng.End(xlDown).Row
    Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("B1:B" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Ws.Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Ws.Range("A1").Select
End Sub

The Option Explicit line is quite important and you can set the editor to always automatically include this line in all modules. When you are in the IDE in the Tools menu choose Options and select check "Require Variable Declaration"

I've added @Tahbaza routine to the bottom of your code - and in your code at the bottom I've added Call SortByDescription to call the sort routine.

Answer 3

Here's a solution, just attach this macro to a button you drop on the worksheet. I simply recorded a macro and then modified it to be less context-specific...

This solution assumes the data or headers start in cell A1 of the active sheet and that there are no empty rows or columns interspersed.

If you want to change the sort column just change the reference to "B".

If you add columns change the reference to "C" to be the final column in the sort area or, better, update the code to detect the last column in the range selected similar to how I determine the last row...

Good luck!

Public Sub SortByDescription()
Dim Rng As Range, Ws As Excel.Worksheet, LastRow As Long
    Set Ws = ThisWorkbook.ActiveSheet
    Set Rng = Ws.Range("A1")
    Ws.Range(Rng, Rng.End(xlToRight)).Select
    Set Rng = Ws.Range(Selection, Selection.End(xlDown))
    LastRow = Rng.End(xlDown).Row
    Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("B1:B" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Ws.Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Ws.Range("A1").Select
End Sub