How to sort data with macro or VBA

**Benjamin2008** · 04-16-2010, 10:28 AM

Dear All,

I am getting a file on daily basis with 10.000 row and 20 different column and everymorning i have to sort the date using the filter option on excel, cos i dont need all the rows and columns on the file. is there any way i can set up macro or VBA that it can select the data and the category of my choice .
I attached a sample and marked columns and rows with yellow colour which the data i need from this file

Could anyone help, I really need this to make my life easier

**bmmerkx** · 04-16-2010, 10:48 AM

Figuring out Macro's by simply recording your actions and reviewing them afterwards is probably the best way to learn. Have you tried pressing the "Record Macro"-button (bottom-left corner of the Excel screen)? Try to record your Macro, then review it by clicking the Developer-tab (upper-right tab in Excel).

If that gets too complex for you,

Sub Macro1()

' What are the headers of the table?
    Range("A1:B1").Select
    Selection.AutoFilter

' Replace "Sheet2" with the name of your sheet
    ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

**Benjamin2008** · 04-16-2010, 11:03 AM

Hi bmmerkx
Thanks for the reply,
I can record a macro very basic ones, i can create based on todays data, but when i get new file tomorrow, i paste row data into macro file and when i click run macro, it does get messey and doesnt pcik up the data i want.

**Leith Ross** · 04-16-2010, 11:13 AM

Hello Benjamin2008,

I see the columns you want to keep. The rows look like column "E", Document Type, is used to determine what will be kept. Is this the complete list? Will this list change?

**Benjamin2008** · 04-16-2010, 11:18 AM

Originally Posted by Leith Ross

Hello Benjamin2008,

I see the columns you want to keep. The rows look like column "E", Document Type, is used to determine what will be kept. Is this the complete list? Will this list change?

Hi Leith Ross

Thanks for the reply,
yes this is the final complete list, so nothing will be changed or deleted or added

Hope you be able to show me away.
many thanks once again
Benjamin

**Leith Ross** · 04-16-2010, 06:53 PM

Hello Benajmin2008,

Sorry for the late response. This was a tricky problem. The biggest issue I had with writing the macro was execution speed. I tried many different ways and this version gave me the best performance. Add this macro to a separate VBA module in your workbook. I am still unable to upload files.

Sub ReduceData()

  Dim DocType As Object
  Dim DstWks As Worksheet
  Dim Item As Variant
  Dim R As Long
  Dim Rng As Range
  Dim SrcWks As Worksheet
  
    Set SrcWks = Worksheets("QuerySheet")
    
    R = 2   'Header Row on destination sheet
    
    Set DocType = CreateObject("Scripting.Dictionary")
    DocType.CompareMode = vbTextCompare
    
    With DocType
      .Add "AP Documents", 1
      .Add "Non PO Invoice", 2
      .Add "PO Invoice", 3
    End With
    
    Set Rng = SrcWks.Range("B8").CurrentRegion
    
     'Delete the Results worksheet
      Application.DisplayAlerts = False
        On Error Resume Next
          Worksheets("Results").Delete
        On Error GoTo 0
      Application.DisplayAlerts = True
          
     'Make s copy of the QuerySheet and rename it Results
      SrcWks.Copy After:=Worksheets(Worksheets.Count)
      Set DstWks = ActiveSheet
      DstWks.Name = "Results"
          
     'Remove the merged header cells in rows 1 o 7
      DstWks.Range("1:7").Delete
      DstWks.Cells(1, 1).EntireRow.Insert
      
     'Set data range to Skip the header row (QuerySheet)
      Set Rng = Rng.Offset(1, 0).Resize(RowSize:=Rng.Rows.Count - 1)
      
     'Clear the destination data range
      DstWks.Cells(R + 1, 2).Resize(Rng.Rows.Count, Rng.Columns.Count).ClearContents
      
     'Copy only data matching the document type
      For Each Item In Rng.Columns(2).Cells
        If DocType.Exists(Item.Value) Then
          R = R + 1
          DstWks.Rows(R) = Item.EntireRow.Value
        End If
      Next Item
      
     'Remove the unneeded columns on Results
      DstWks.Range("X:AN,T:V,R:R,O:O,G:L").Delete
               
    DstWks.Cells(2, 2).Select
    Set DocType = Nothing
    
End Sub