Row Data Covert To Column date wise

god_karthi · May 11th 2015

Hi,

I need to convert row data to column accordingly date wise. I have attached work book for reference and easy understand.
In Column A is date and it will go no of rows .
In Column K Is Name and it will go accordingly date.

In Column AK Data will transfer to row basis accordingly to name Vs date.
I have made code below to avoid duplicate names only .so kindly add for changes in result sheet Accordingly to transfer .
I hope this clear.if any one will help me it will more useful for me.
Thanks in Advance.

Code

Dim lastrow As Long    Application.ScreenUpdating = False
     
 
      'code name for master sheet
        
        
       With Sheets("sheet2")
                 '// determine the last data row using column-E Company Name
        lastrow = .Cells(Rows.Count, "K").End(xlUp).Row
         
         
         '// turn of any existing filter
        .AutoFilterMode = False
         
         
         '// clear the paste range to receive unique list of company names in subsequent filter action
        .Range("B2").EntireColumn.ClearContents
        .Range("K3:k" & lastrow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Result").Range("K3"), Unique:=True
        .AutoFilterMode = False
        
        End With
       Application.ScreenUpdating = True

Display More

MickG · May 11th 2015

Re: Row Data Covert To Column date wise

Try this:-
Data "Sheet2", Results sheet "Result"

Code

Sub nDates()
Dim Rw As Long, Dn As Range
Dim Rng As Range
Dim Dic As Object
Dim Q As Variant, oMax As Long
Dim k As Variant, ac As Long
Dim p As Variant, c As Long
   
  With Sheets("Sheet2")
    Set Rng = .Range(.Range("K3"), .Range("K" & Rows.Count).End(xlUp))
End With
Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
    For Each Dn In Rng
            If Not Dic.exists(Dn.Value) Then
                Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            End If
            If Not Dic(Dn.Value).exists(Dn.Offset(, -10).Value) And Dn.Offset(, 26).Value > "" Then
                Dic(Dn.Value).Item(Dn.Offset(, -10).Value) = Dn.Offset(, 26).Value
            End If
    Next Dn
c = 1
ReDim Ray(1 To Rng.Count + 1, 1 To Rng.Count)
     Ray(1, 1) = "Operators Name"
    For Each k In Dic.Keys
        If Not IsEmpty(k) Then
            ac = 1: c = c + 1
            Ray(c, 1) = k
            For Each p In Dic(k)
                ac = ac + 1
                oMax = Application.Max(oMax, ac)
                Ray(1, ac) = p
                Ray(c, ac) = Format(Dic(k).Item(p), "0.00")
            Next p
    End If
Next k
With Sheets("Result").Range("A1").Resize(c, oMax)
    .Value = Ray
    .Columns.AutoFit
 End With

Display More

**KjBox** · May 11th 2015

Re: Row Data Covert To Column date wise

An alternative approach:

Code

Option Explicit


Sub Button2_Click()
    Dim x, y, Dates, OpNames, i As Long, ii As Long, iii As Long
    Dim ALDt As Object, ALOp As Object, j As Long
    
    Set ALDt = CreateObject("system.collections.ArrayList")
    Set ALOp = CreateObject("system.collections.ArrayList")
    x = Sheets("Sheet2").[a2].CurrentRegion.Value
    For i = 2 To UBound(x, 1)
        If Not ALDt.contains(x(i, 1)) Then ALDt.Add x(i, 1): AlDt.Sort
    Next
    For i = 2 To UBound(x, 1)
        If x(i, 11) <> "No Load" And Not ALOp.contains(x(i, 11)) Then ALOp.Add x(i, 11): ALOp.Sort
    Next
    Dates = ALDt.toarray: OpNames = ALOp.toarray
    ReDim y(1 To UBound(OpNames) + 2, 1 To UBound(Dates) + 3)
    y(1, 1) = "S.No": y(1, 2) = "Operator"
    For i = 0 To UBound(Dates, 1)
        y(1, i + 3) = Dates(i)
    Next
    For ii = 0 To UBound(Dates, 1)
        For iii = 0 To UBound(OpNames, 1)
            For i = 2 To UBound(x, 1)
                If x(i, 1) = Dates(ii) And x(i, 11) = OpNames(iii) Then
                    y(iii + 2, 1) = iii + 1: y(iii + 2, 2) = OpNames(iii)
                    If x(i, 37) <> "" And x(i, 37) > y(iii + 2, ii + 3) Then y(iii + 2, ii + 3) = x(i, 37)
                End If
            Next
        Next
    Next
    With Sheets("Result").[a2]
        .CurrentRegion.Clear
        .Resize(UBound(y, 1), UBound(y, 2)).Value = y
        With .CurrentRegion
            .Offset(, 1).Resize(, .Columns.Count - 1).Borders.Weight = 2
            .Offset(1, 2).Resize(, .Columns.Count - 2).NumberFormat = "0.00"
            .Offset(, 2).Resize(1, .Columns.Count - 2).NumberFormat = "d/mm/yyyy"
        End With
        .Parent.Columns.AutoFit
    End With
        
End Sub

Display More

Note: This sorts the Operator Names alphabetically before placing them in Result table and leaves out any entries for "No Load".
If you do not want the names sorted alphabetically then remove :ALOp.Sort from the code.
If you still need "No Load" to be recorded then change

Code

If x(i, 11) <> "No Load" And Not ALOp.contains(x(i, 11)) Then ALOp.Add x(i, 11): ALOp.Sort

To

Code

If Not ALOp.contains(x(i, 11)) Then ALOp.Add x(i, 11): ALOp.Sort

god_karthi · May 11th 2015

Re: Row Data Covert To Column date wise

Dear Sirs,
Thanks for reply and spend your valuable time for me.
Mr.MickG your code is working fine but only thing is the date is not coming correct .( I have attached work book)
Mr.KjBox your code is good what i am expecting with border lines and serial no .but only thing is working only two days only.I need to increase many dates.

One more thing I found if same date same name is there then value will come in average.
I hope both of you will understand my problem.
Once more thanks for spend your valuable time for me.

Thanks.
God_karthi

**KjBox** · May 11th 2015

Re: Row Data Covert To Column date wise

I have edited the code in my last post, this will accommodate any number of dates and if an Operator name appears twice or more for the same date then the highest value is recorded.

Note I have also added Sort for the names and omitted "No Load" from the recorded data, see the notes at the end of that post about not wanting names sorted and/or "No Load omitted.

Leave the Dates being sorted though, it just corrects the possibilty of dates not being in order in the main data table and places them in ascending order in the Result Table.

**KjBox** · May 11th 2015

Re: Row Data Covert To Column date wise

Just read your last post again, do you mean you want an average if same date and name occurs more than once?

What about when one of those is empty? Do you still want to average cells with a value AND the empty cell (value of that would be 0)?

god_karthi · May 11th 2015

Re: Row Data Covert To Column date wise

Thanks sir for reply.

I need if same date with same person then i need average otherwise same data will come.
if some time is blank then I need as it is blank.
Note: only thing is need average if any value.

like below I mention:

case 1:
1-5-15 A 45
1-5-15 A 100 result is 72.5

Case 2:

1-5-15 A 45
1-5-15 A result is 45

case 3:

1-5-15 A 45
result is 45

case 4:

1-5-15 A
result is

I hope you will understand what I need.this thing I need date wise accordingly.

Thanks in advance

god_karthi

**KjBox** · May 11th 2015

Re: Row Data Covert To Column date wise

This will ignore empty cells when calculating average

Code

Sub Button2_Click()
    Dim x, y, Dates, OpNames, i As Long, ii As Long, iii As Long
    Dim ALDt As Object, ALOp As Object, j As Long, icount As Integer
    
    Set ALDt = CreateObject("system.collections.ArrayList")
    Set ALOp = CreateObject("system.collections.ArrayList")
    x = Sheets("Sheet2").[a2].CurrentRegion.Value: icount = 1
    For i = 2 To UBound(x, 1)
        If Not ALDt.contains(x(i, 1)) Then ALDt.Add x(i, 1)
        If x(i, 11) <> "No Load" And Not ALOp.contains(x(i, 11)) Then ALOp.Add x(i, 11)
    Next
    ALDt.Sort: Dates = ALDt.toarray
    ALOp.Sort: OpNames = ALOp.toarray
    ReDim y(1 To UBound(OpNames) + 2, 1 To UBound(Dates) + 3)
    y(1, 1) = "S.No": y(1, 2) = "Operator Name"
    For i = 0 To UBound(Dates, 1)
        y(1, i + 3) = Dates(i)
    Next
    For ii = 0 To UBound(Dates, 1)
        For iii = 0 To UBound(OpNames, 1)
            For i = 2 To UBound(x, 1)
                If x(i, 1) = Dates(ii) And x(i, 11) = OpNames(iii) Then
                    y(iii + 2, 1) = iii + 1: y(iii + 2, 2) = OpNames(iii)
                    If x(i, 37) <> "" Then
                        If IsEmpty(y(iii + 2, ii + 3)) Then
                            y(iii + 2, ii + 3) = x(i, 37)
                        Else
                            icount = icount + 1
                            y(iii + 2, ii + 3) = (y(iii + 2, ii + 3) + x(i, 37)) / icount
                        End If
                    End If
                End If
                icount = 1
            Next
        Next
    Next
    With Sheets("Result").[a2]
        .CurrentRegion.Clear
        .Resize(UBound(y, 1), UBound(y, 2)).Value = y
        With .CurrentRegion
            .Borders.Weight = 2
            .Offset(1, 2).Resize(, .Columns.Count - 2).NumberFormat = "0.00"
            .Offset(, 2).Resize(1, .Columns.Count - 2).NumberFormat = "d/mm/yyyy"
        End With
        .Parent.Columns.AutoFit
    End With
        
End Sub

Display More

god_karthi · May 11th 2015

Re: Row Data Covert To Column date wise

Thank you sir perfect working what i need exactly data is coming thanks for your help.
column A is not coming border how I could add.If not possible then Not a issue.
But thanks for you valuable help for me.
Thanks,
God_karthi

**KjBox** · May 11th 2015

Re: Row Data Covert To Column date wise

I left the border out of Column A because that is how it was in your sample file.

To have borders around all the cells in the table change

Code

.Offset(, 1).Resize(, .Columns.Count - 1).Borders.Weight = 2

To

Code

.Borders.Weight = 2

god_karthi · May 11th 2015

Re: Row Data Covert To Column date wise

Thanks sir perfect.

Thanks for your valuable help.

**KjBox** · May 11th 2015

Re: Row Data Covert To Column date wise

You're welcome

Row Data Covert To Column date wise

Participate now!

Share