Macro for arranging in descending order.

**Taureankv** · 03-03-2010, 02:50 PM

Hello All,

I am new to this forum (a little over than a week). Frankly speaking, i haven't seen an MS Excel VBA forum so active with all experienced individuals. I would require your assistance in writing a macro and would appreciate any help on it.

I have these three enclosed files which i update every week.Each of the three sheets include:

Row 1: Red highlighted area is for a new transaction and date at which it occurred.
Row 2: Description of the transaction (will always remain fixed)
Row 3: Details of the transaction (could go up to a maximum number of 10-15)

The challenge that i face is of arranging them in descending order (latest date transaction should appear first following the others) in a separate spreadsheet.

Please help..Thank you...

**blane245** · 03-03-2010, 04:09 PM

Welcome to the forum! How expereinced are you with Excel VBA? I've got an idea for how to do this, but I need to know where you are coming from.

**Leith Ross** · 03-03-2010, 10:24 PM

Hello Taureankv,

Welcome tot he Forum!

I have added the following macro to the attached workbook. This will sort all the accounts in the open workbooks and copy the account information tables to the main workbook on "Sheet1".

The macro assumes the following conditions:
1) The layout of the actual files to be the same as the original.
2) All worksheets that contain account information are assumed to be named "Sheet1".
3) All account information data is separated by 1 blank line.

Sub ListAccounts()

  Dim Account As String
  Dim Cell As Range
  Dim Data As Range
  Dim DSO As Object
  Dim MainWkb As Workbook
  Dim R As Long
  Dim Rng As Range
  Dim TD As String
  Dim Wkb As Workbook
  Dim Wks As Workbook

    Set MainWkb = ThisWorkbook
    Set DSO = CreateObject("Scripting.Dictionary")
    
      For Each Wkb In Workbooks
       If Wkb.Name <> MainWkb.Name Then
          R = 1
          With Wkb.Worksheets(1)
            While .Cells(R, "A").Address <> .Cells(R, "A").CurrentRegion.Address
             'Get Account name and  transaction date
              Account = .Cells(R, "A")
              TD = Format(.Cells(R, "F"), "mm/dd/yyyy")
             'Get the cells that make up the table
              Set Data = .Cells(R, "A").CurrentRegion
              DSO.Add TD & " " & Account, Data
              R = R + .Cells(R, "A").CurrentRegion.Rows.Count + 1
            Wend
          End With
       End If
      Next Wkb
      
     'Sort the list of account names by date in descending order
      With MainWkb.Worksheets("Sheet2")
        Set Rng = .Range("A1").Resize(DSO.Count, 1)
        Rng.Clear
        Rng.Value = WorksheetFunction.Transpose(DSO.Keys)
        Rng.Sort Key1:=Rng.Cells(1, 1), Order1:=xlDescending, _
                 Header:=xlNo, Orientation:=xlTopToBottom
      End With
      
     'Copy account tables in descending order to "Sheet1" in the main workbook
      With MainWkb.Worksheets("Sheet1")
        R = 1
        For Each Cell In Rng
          DSO(Cell.Text).Copy
          .Cells(R, 1).PasteSpecial Paste:=xlPasteAll
          R = R + DSO(Cell.Text).Rows.Count + 1
        Next Cell
      End With
      
   'Free the object and memory used
    Set DSO = Nothing
    
End Sub