Hi all
Below is a bit of code. I prompt user to select a cell (although so far its possible to select more than one but I'll fix that) as starting point from which a table will be inserted. Then I prompt for user input to specify the range in a pivot table frequency array formulas calculations should be based on.
It's actually working OK if the user selects the top row, but I would like to skip the user input.
The solution I am really after should set a variable range for the formulas referencing the datarow in the pivot table and also a way to insert the starting point for the new table in the same row as the pivot tableheaders offset by two columns.
My first problem I need help with is setting the first datarow in a pivot table as a range (not knowing the value of either the label or the headers) and also to set the starting point two columns to the right of the pivot table . I have read through countless of post and blogs on how to reference tables but I cant get it to work.
My second problem is that the code below doesn't exactly qualify as tidy. I am using select which is not cool, I repeat my self pointing at each sell to paste values and I have specified the size of the new table as 8 where ideally that would be a variable equal to the highest MAX. I simply haven't been able to make a loop that work. Any ideas as to how?
I would be very happy indeed for any help.
I haven't uploaded an example but would be happy to if needed.
Kind regards
Kasper
Below is a bit of code. I prompt user to select a cell (although so far its possible to select more than one but I'll fix that) as starting point from which a table will be inserted. Then I prompt for user input to specify the range in a pivot table frequency array formulas calculations should be based on.
It's actually working OK if the user selects the top row, but I would like to skip the user input.
The solution I am really after should set a variable range for the formulas referencing the datarow in the pivot table and also a way to insert the starting point for the new table in the same row as the pivot tableheaders offset by two columns.
My first problem I need help with is setting the first datarow in a pivot table as a range (not knowing the value of either the label or the headers) and also to set the starting point two columns to the right of the pivot table . I have read through countless of post and blogs on how to reference tables but I cant get it to work.
My second problem is that the code below doesn't exactly qualify as tidy. I am using select which is not cool, I repeat my self pointing at each sell to paste values and I have specified the size of the new table as 8 where ideally that would be a variable equal to the highest MAX. I simply haven't been able to make a loop that work. Any ideas as to how?
I would be very happy indeed for any help.
I haven't uploaded an example but would be happy to if needed.
Kind regards
Kasper
Code:
Sub TaleToCalculateMaxAndSuccesive()
Dim rRange As Range
Dim rSelect As Range
Dim tRange As Range
Dim FormulaPart1 As String
Dim FormulaPart2 As String
Dim r As Range
Dim PT As PivotTable
'select the cell from which the table should be pasted
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Angiv den en celle hvor du vil have frekvenstabllen til at starte med samentælling af serier i", _
Title:="BRUG MUSEN TIL AT ANGIVE OMRÅDE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
Else
End If
'select the data area for the array formula
On Error Resume Next
Application.DisplayAlerts = False
Set rSelect = Application.InputBox(Prompt:= _
"Marker hele den øverste cellerække med data som der skal tælles i ", _
Title:="BRUG MUSEN TIL AT ANGIVE OMRÅDE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rSelect Is Nothing Then
MsgBox "Intet område angivet"
Exit Sub
Else
Application.ScreenUpdating = False
'calls another sub that copies the first row of the pivottable
Call CopyRowRange
'---- bekow is the called sub
'Sub CopyRowRange()
'Dim PT As PivotTable
'Set PT = ActiveSheet.PivotTables(1)
'PT.RowRange.Copy
'
'End Sub
'------
'pastes the first column of the pivot table (including header name) in the first specified cell - rRange. In this case it is the names of participants.
rRange.Offset(-1, 0).PasteSpecial Paste:=xlPasteValues
'the pasted values is used to create a table
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Table name"
'as the data is now a table whenever a value is pasted to an adjacent cell it becomes part of the table
'which is handy beacuese when I pase the array formulas below they autofill all the way down
rRange.Offset(-1, 1).Value = "Længste serie"
rRange.Offset(-1, 2).Value = "Antal serier af 2"
rRange.Offset(-1, 3).Value = "Antal serier af 3"
rRange.Offset(-1, 4).Value = "Antal serier af 4"
rRange.Offset(-1, 5).Value = "Antal serier af 5"
rRange.Offset(-1, 6).Value = "Antal serier af 6"
rRange.Offset(-1, 7).Value = "Antal serier af 7"
rRange.Offset(-1, 8).Value = "Antal serier af 8"
'pastes array formula for max frequency - and because it is a talbe it autofills
rRange.Offset(0, 1).FormulaArray = "=MAX(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(" + rSelect.Address(False, False) + "<>1,COLUMN(" + rSelect.Address(False, False) + "))))"
'pastes array formula for counts of 2 in succesion, for 3 in succesion and so on and so on.
rRange.Offset(0, 2).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=2,1))"
rRange.Offset(0, 3).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=3,1))"
rRange.Offset(0, 4).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=4,1))"
rRange.Offset(0, 5).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=5,1))"
rRange.Offset(0, 6).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=6,1))"
rRange.Offset(0, 7).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=7,1))"
rRange.Offset(0, 8).FormulaArray = "=SUM(IF(FREQUENCY(IF(" + rSelect.Address(False, False) + "=1,COLUMN(" + rSelect.Address(False, False) + ")),IF(1-(" + rSelect.Address(False, False) + "=1),COLUMN(" + rSelect.Address(False, False) + ")))=7,1))"
End If
rRange.Offset(-1, 0).Columns.AutoFit
Application.ScreenUpdating = True
End Sub