In the columns 0-12 I should have the avg expression values.I need this form of table for various reasons.I have constructed a vba code but it doenst work like I wanted to so I would like your opinion on whats wrong(sorry its my first time with vba).Basicallly, the code is that if I have the same value in B column for 15 consecutive times then I want the values from A column from the same range transposed to the new table and the range from B column to be deleted(that is why the new data will always be trasported on the top of the table and checked there).But if that is not the case and I have less than 15 values then I want that part of the table to be transefered to the bottom of a new table and the original part to be deleted
I filtered and origianal table and I am sending the new one
I hope I was clear.I can answer questions if I am confusing on some parts
Sub TransposeRange()
Dim c As Range
For Each c In Sheets("Table").Range("F30:F911").Rows
If B2 = B16 Then
'specify range to transpose
Dim MyRange()
MyRange = Range("A2:A16")
'find dimensions of range
XUpper = UBound(MyRange, 1)
XLower = LBound(MyRange, 1)
YUpper = UBound(MyRange, 2)
YLower = LBound(MyRange, 2)
'transpose range
Range(c).Resize(YUpper - YLower + 1, XUpper - XLower + 1).Value = _
WorksheetFunction.Transpose(MyRange)
'delete range
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
For i = 1 To 15
tbl.ListRows(1).Delete
Next
Else
Dim Value As String
Value = Table.Range("B2")
Dim x As Integer
x = WorksheetFunction.CountIf(Table.Range("B2:B16"), Value)
lngLastRow_V = Cells(Rows.Count, "V").End(xlUp).Row
lngLastRow_X = Cells(Rows.Count, "X").End(xlUp).Row
Range("A2:Cx").Cut Range("lngLastRow_V:lngLastRow_X")
Range("A2:Cx").Delete
End If
Next
End Sub
