0

I have raw data I'm trying to sort out by date, the data is in this form:

month:april-2014
offer    | value 
ofr x    | 2132
ofr y    | 135
.
.
.
month:mai-2014
offer   | value
ofr x   | 5115
ofr z   | 513
ofr y   | 651

and it goes on, there are offers that apear every month and others that dissapear.

I wanted it to look like this :

offer  | april-2014 |mai 14 | june ....
ofr x      123         5        6  
ofr y       5           1        6 
ofr z
ofr a

. . any help would be appreciated, thank you

Kadi.b
  • 1
  • 1
  • are you looking for your results ie new list, on a new worksheet, somewhere else on the same work sheet, deleting the old list and replacing with new? – Forward Ed Apr 26 '16 at 16:10
  • are their any blank rows in your source data? Or does it go straight from the last offer to month in the next row? – Forward Ed Apr 26 '16 at 20:28

2 Answers2

0

Try to restructure the data like this and use pivot tables?

Date     | offer  | value
may-2014 |ofr x   | 5115
may-2014 |ofr z   | 513
may-2014 |ofr y   | 651
Jack Xie
  • 61
  • 2
  • 6
0

This first chunk of code is going through and rearranging things for you. The other important thing it does is only sends one column from your selected range to the function. Some important things to remember are you may need to write the search criteria if you key word for "month" is not in the same spot in the text, the word offer is not by itself with no spaces in the following row. Another point of note, is this is treating everything as is. That means if the source cell was text, then the destination cell will be text. To convert from date as text to date as Excel serial that is a separate issue and there are plenty of ways to achieve that as well.

Option Explicit Sub SortOffer(OfferList As Range)

Dim CounterX As Long, CounterY As Long, jCounter As Long, icounter As Long, MonthCount As Long, UniqueOffers As Long
Dim inlist As Boolean
Dim unsorted() As Variant
Dim sorted() As Variant

MonthCount = WorksheetFunction.CountIf(OfferList, "month*")
UniqueOffers = CountUnique(OfferList.Columns(1).Cells) - MonthCount - 1


ReDim sorted(1 To UniqueOffers + 1, 1 To MonthCount + 1) As Variant

unsorted = OfferList

CounterX = 1
jCounter = 1
sorted(1, 1) = "offer"


For CounterY = LBound(unsorted, 1) To UBound(unsorted, 1)

    If Left(unsorted(CounterY, 1), 5) = "month" Then
        CounterX = CounterX + 1
        sorted(1, CounterX) = Right(unsorted(CounterY, 1), Len(unsorted(CounterY, 1)) - 6)
    Else
        inlist = False
        For icounter = 2 To jCounter
            If unsorted(CounterY, 1) = sorted(icounter, 1) Then
                sorted(icounter, CounterX) = unsorted(CounterY, 2)
                inlist = True
            End If
        Next icounter

        If Not inlist And unsorted(CounterY, 1) <> "offer" And unsorted(CounterY, 1) <> "" Then
            jCounter = jCounter + 1
            sorted(jCounter, 1) = unsorted(CounterY, 1)
            sorted(jCounter, CounterX) = unsorted(CounterY, 2)
        End If
    End If
Next CounterY

Range("F1").Resize(UBound(sorted, 1), UBound(sorted, 2)).Value = sorted

End Sub

This next function counts the number of unique entries in a range and does not count spaces. I stumbled across this code on this web page. If you subtract the number of months from this count, you will know how many offers are in your table. This is important because it will tell you how to size your array(alt link) that you will later write back as your results

Function CountUnique(ByVal MyRange As Range) As Integer
    Dim Cell As Range
    Dim J As Integer
    Dim iNumCells As Integer
    Dim iUVals As Integer
    Dim sUCells() As String

    iNumCells = MyRange.Count
    ReDim sUCells(iNumCells) As String

    iUVals = 0
    For Each Cell In MyRange
        If Cell.Text > "" Then
            For J = 1 To iUVals
                If sUCells(J) = Cell.Text Then
                    Exit For
                End If
            Next J
            If J > iUVals Then
                iUVals = iUVals + 1
                sUCells(iUVals) = Cell.Text
            End If
        End If
    Next Cell
    CountUnique = iUVals
End Function

Now just in case the links don't cover it, this answer which was a learning lesson for me was taught in various parts to me by @JNevill, @Ralph, @findwindow, @Gary'sStudent and @ScottCraner. Appologies if I missed someone. I am also sure any of these individuals could do it slicker and take less then 10 hours to write it 8).

Community
  • 1
  • 1
Forward Ed
  • 9,484
  • 3
  • 22
  • 52