+ Reply to Thread
Results 1 to 6 of 6

Need to sort groups of data by name or date

  1. #1
    Registered User
    Join Date
    11-04-2011
    Location
    Portland, Oregon
    MS-Off Ver
    Excel 2010
    Posts
    2

    Red face Need to sort groups of data by name or date

    I've been trying to figure out a way to sort this data dump, and I'm at a loss. I pull a report every day that has failed transactions. Each transaction is arranged in a group that starts the first row with the word "Payer" and ends with the second occurence of the word "Total:". Each group can have several items listed in the transaction, so there are not always the same number of rows in a group. I need to be able to sort the data by either the date or the payer name.

    Here's a sample of the data (I hope this works). I'm also attaching a small sample of three transactions.

    [code]
    Payer Created Date Company
    ABC Company (131427) 11/3/2011 ABC Company (131427)
    Item Description Price Tax
    Company Enrollment $199.00 $0.00
    Total: $199.00 $0.00

    Amount Status
    $199.00 Failed
    Total: $0.00
    [\code]

    I'm sure there's a way to do this, but I'm not a programmer so much of the VBA I read is very confusing to me. Any assistance provided will be greatly appreciated!
    Attached Files Attached Files

  2. #2
    Forum Contributor
    Join Date
    11-04-2011
    Location
    pak
    MS-Off Ver
    Excel 2007
    Posts
    132

    Re: Need to sort groups of data by name or date

    Hello mockturtle29


    although I am new to VB excell, I have tried hard for 2 days to solve your problem, here is what I could do. I assumed here each final "Total:" has two empty rows between the "payer" and "Total:". From expert point of view this is not very smart effort. this is my limitation of knowledge.hope this solves your problem.




    Public Sub workbook_fail()

    Dim RngToCopy As Range
    Dim DestCell As Range

    joker = 0
    lower = 0
    upper = 0
    ntimes = 1
    initarray = 0
    i = 0
    j = 0
    m = 0
    n = 0



    '=====================================================================

    ' loop to take the last row counter of the data

    '=====================================================================
    Sheets("sheet1").Select

    For n = 1 To 1000000


    If Cells(n, 1).Value = "" Then
    n = n + 2
    If Cells(n, 1).Value = "" Then
    n = n + 2
    If Cells(n, 1).Value = "" Then

    n = n - 5


    Exit For
    End If
    End If
    End If


    Next



    '=====================================================================

    ' block to check the two consective empty cells after each Payer and "Total"

    '=====================================================================

    For joker = ntimes To n

    If Cells(joker, 1).Value = "Payer" Then

    Cells(joker, 1).Select

    lower = joker

    Else

    If Cells(joker, 1).Value = "Total:" Then

    Cells(joker, 1).Select

    joker = joker + 1

    If Cells(joker, 1).Value = "" Then
    joker = joker + 1
    If Cells(joker, 1).Value = "" Then

    upper = joker - 2
    ntimes = joker + 1









    '=====================================================================

    ' inner block which check failed value condition

    '=====================================================================
    copl = lower
    copu = upper

    For i = lower To upper


    For n = 1 To 5


    If Cells(i, n).Value = "Failed" Then

    Cells(i, n).Select
    Sheets("sheet1").Select
    Range(Cells(copl, 1), Cells(copu, 5)).Select
    Selection.Copy

    Sheets("sheet2").Select
    Range(Cells(copl, 1), Cells(copu, 5)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Exit For


    End If


    Next



    Next

    '=====================================================================

    ' END inner block which check failed value condition, Block paste values if failed condition satisfied

    '=====================================================================






    End If
    End If
    End If
    End If

    Sheets("sheet1").Select



    Next joker






    End Sub

  3. #3
    Forum Contributor
    Join Date
    11-04-2011
    Location
    pak
    MS-Off Ver
    Excel 2007
    Posts
    132

    Re: Need to sort groups of data by name or date

    Hi,
    here is a more quicker code than the previous one:


    Public Sub workbook_fail()
    Application.ScreenUpdating = False
    Dim RngToCopy As Range
    Dim DestCell As Range
    joker = 0
    lower = 0
    upper = 0
    ntimes = 1
    initarray = 0
    i = 0
    j = 0
    m = 0
    n = 0

    '=====================================================================

    ' loop to take the last row counter of the data

    '=====================================================================
    Sheets("sheet1").Select

    For n = 1 To 1000000


    If Cells(n, 1).Value = "" Then
    n = n + 2
    If Cells(n, 1).Value = "" Then
    n = n + 2
    If Cells(n, 1).Value = "" Then
    n = n - 5
    Exit For
    End If
    End If
    End If

    Next

    '=====================================================================

    ' block to check the two consective empty cells after each Payer and "Total"

    '=====================================================================

    For joker = ntimes To n

    If Cells(joker, 1).Value = "Payer" Then
    Cells(joker, 1).Select
    lower = joker
    Else
    If Cells(joker, 1).Value = "Total:" Then
    Cells(joker, 1).Select
    joker = joker + 1
    If Cells(joker, 1).Value = "" Then
    joker = joker + 1
    If Cells(joker, 1).Value = "" Then
    upper = joker - 2
    ntimes = joker + 1

    '=====================================================================

    ' inner block which check failed value condition

    '=====================================================================
    copl = lower
    copu = upper

    For i = lower To upper
    For n = 1 To 5
    If Cells(i, n).Value = "Failed" Then
    Sheets("sheet1").Range(Cells(copl, 1), Cells(copu, 5)).Select
    Selection.Copy
    Sheets("sheet2").Select
    Range(Cells(copl, 1), Cells(copu, 5)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Exit For
    End If
    Next
    Next

    '=====================================================================

    ' END inner block which check failed value condition, Block paste values if failed condition satisfied

    '=====================================================================
    End If
    End If
    End If
    End If
    Sheets("sheet1").Select
    Next joker
    Application.ScreenUpdating = True
    End Sub

  4. #4
    Registered User
    Join Date
    11-04-2011
    Location
    Portland, Oregon
    MS-Off Ver
    Excel 2010
    Posts
    2

    Re: Need to sort groups of data by name or date

    This first one processes the spreadsheet and copies it without formatting to a new sheet, but it does not sort it or make it sortable. Is there a way to make it sort either alphabetically by "Payer" or "Company" or sequentially by "Created Date"?

    I'm exceedingly grateful to you for working on this with me!

  5. #5
    Forum Contributor
    Join Date
    11-04-2011
    Location
    pak
    MS-Off Ver
    Excel 2007
    Posts
    132

    Re: Need to sort groups of data by name or date

    what you mean is, it should be arranged in the form of same data blocks? but in order of date created? if you talk about a linear filter that is very difficult, because your data is random.if sorted by Date or Payer name in chunks of data then it can be think over

  6. #6
    Forum Contributor
    Join Date
    11-04-2011
    Location
    pak
    MS-Off Ver
    Excel 2007
    Posts
    132

    Re: Need to sort groups of data by name or date

    hello,
    here is the new code. check if it helps.now you need to have 3 sheets according to this code.Sheet1 data source, Sheet2 filtered data, Sheet3 with tabular data

    Code:
    Public Sub workbook_fail()
    Application.ScreenUpdating = False
    Dim RngToCopy As Range
    Dim DestCell As Range
    joker = 0
    lower = 0
    upper = 0
    ntimes = 1
    initarray = 0
    i = 0
    j = 0
    m = 0
    n = 0
    r = 2

    '=====================================================================

    ' loop to take the last row counter of the data

    '=====================================================================
    'clear sheet contents and formats
    Sheets("sheet3").Select
    Columns("A:F").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("sheet2").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp

    Sheets("sheet1").Select

    For n = 1 To 1000000


    If Cells(n, 1).Value = "" Then
    n = n + 3
    If Cells(n, 1).Value = "" Then
    n = n + 4
    If Cells(n, 1).Value = "" Then
    n = n - 7
    Exit For
    End If
    End If
    End If

    Next

    '=====================================================================

    ' block to check the two consective empty cells after each Payer and "Total"

    '=====================================================================

    For joker = ntimes To n

    If Cells(joker, 1).Value = "Payer" Then
    Cells(joker, 1).Select
    lower = joker
    Else
    If Cells(joker, 1).Value = "Total:" Then
    Cells(joker, 1).Select
    joker = joker + 1
    If Cells(joker, 1).Value = "" Then
    joker = joker + 1
    If Cells(joker, 1).Value = "" Then
    upper = joker - 2
    ntimes = joker + 1

    '=====================================================================

    ' inner block which check failed value condition

    '=====================================================================
    copl = lower
    copu = upper


    For q = lower To upper
    For m = 1 To 5
    If Cells(q, m).Value = "Failed" Then
    Sheets("sheet1").Range(Cells(copl, 1), Cells(copu, 5)).Select
    Selection.Copy
    Sheets("sheet2").Select
    Range(Cells(copl, 1), Cells(copu, 5)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range(Cells(copl, 1), Cells(copu, 5)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    For p = r To 100000
    Sheets("sheet1").Select
    Range(Cells(lower + 1, 1), Cells(lower + 1, 5)).Select
    Selection.Copy
    Sheets("sheet3").Select
    Range(Cells(p, 1), Cells(p, 5)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'Range(Cells(p, 1), Cells(p, 5)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Sheets("sheet3").Select
    Range(Cells(p, 1), Cells(p, 5)).Select
    Sheets("Sheet1").Select
    Cells(q, m).Offset(0, -1).Select
    Selection.Copy
    Sheets("Sheet3").Select
    Cells(p, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Cells(p, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Cells(p, 6).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    r = r + 1
    Exit For

    Next



    Exit For
    End If


    Next
    Next




    '=====================================================================

    ' END inner block which check failed value condition, Block paste values if failed condition satisfied

    '=====================================================================
    End If
    End If
    End If
    End If
    Sheets("sheet1").Select
    Next joker

    Sheets("sheet3").Select
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll Down:=0
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Compnay Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Date "
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "company information"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Payment($)"
    Columns("A:D").Select
    Selection.ColumnWidth = 27.43
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1