When creating the pivot chart using VBA, I set the size of the chart depending on the number of different values that I have in the chart. With pivot charts you have the option to select only some values of the chart. So for example if I have this chart:
And then I select only 2 I get this:
This is too big and sometimes it can be even bigger. What I would like is to resize it automatically when a user select less so that it automatically become smaller. So I would like it to be something like this:
Is there any way to change the width automatically using VBA?
You may want to take a look at these: resize (mrexcel) & Count number of series (stackoverflow)
In these sources there are some code snippets for getting the number of series in a chart and resizing charts to a fit to a range in the worksheet
Im by no means an expert coder, but with the code and concepts in the above you may be able to do something like this to a given ChartObject:
'get the number of series in a given ChartObject:
numberOfSeries = ChartObject.Chart.SeriesCollection.Count
'you can use this to specify a width in cells/as a range. For the purpose of this example I
'eventually want the chart to cover 1 cell width for each series, + 1.
myChartWidth = numberOfSeries + 1
'Give the chart a name. Smarter people may supply a solution that reference the ChartObject
'directly, but I am not that clever
ChartObject.Name = "Your Chart"
'I will use A1 as reference for setting width, change as you see fit
Sheet1.Shapes("Your Chart").Width = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, myChartWidth)).Width
'I assume you want to fix the height, adjust to your requirements
Sheet1.Shapes("Your Chart").Height = Sheet1.Range("A1:A10").Height
'If you want to also place the chart top left corner in the in the top left of A1, you can do the following
Sheet1.Shapes("Your Chart").Left = Sheet1.Cells(1, 1).Left
Sheet1.Shapes("Your Chart").Top = Sheet1.Cells(1, 1).Top
You probably want to place and size it differently, but I hope the ideas or the linked sources can get you closer to a solution
Finally I found a solution using the change event. So when I select different values I check how many values I have and then resize my chart depending on the values quantity.
Here is an example of what I used (I have 2 different pivot tables in my sheet)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GetOut
If Target.PivotTable.Name = "PivotTable1" Then
Sheets("PerPublication").Shapes(1).Width = (Target.PivotTable.RowRange.Count * 50) + 100
End If
If Target.PivotTable.Name = "PivotTable2" Then
Sheets("PerPublication").Shapes(2).Width = (Target.PivotTable.RowRange.Count * 40) + 40
End If
GetOut:
If Err.Description <> "" Then
Err.Clear
End If
End Sub
Related
I do not know if this is appropriate to place in stackoverflow despite being VBA related--particularly in the UserForms area, however, I cannot visualize at all how i'm going to code this.
My Excel worksheet is shown below:
The UserForm I created to input the data is as shown below:
However, what I want to achieve is similar to how QuickBooks does it where the Amount Due is automatically distributed among the Expense Accounts without having to input them 1 by 1 as shown in the first image (My excel worksheet). Also, when there are more expense accounts than usual (e.g. 10 expense accounts, Quickbooks will automatically add new rows for that purpose). A sample is shown below:
My main issue is that I do not know how to let UserForms dynamically add more rows if I need to do so. It can be automatically add rows when all previous rows are filled or something as shown in the image below:
Let n be the number of expense accounts
So from having to input n*2 (or in my case 4 values):
Telephone/Insurance Expense: 40,000
Cash in Bank 40,000
Water Expense: 40,000
Cash in Bank: 40,000
I can to simplify it to n+1 inputs (or in my case 3 inputs):
Amount Due: 80,000
Telephone/Insurance Expense: 40,000
Water Expense 40,000
A lot of examples and tutorials how to add controls dynamically can be found, for example
how-to-create-controls-dynamically-at-runtime
adding-controls-to-a-frame-in-an-excel-userform-with-vba
vba-userform-basics-add-controls-dynamically-at-run-time
However, depending on the maximum number of lines, maybe it is a better solution to create all the controls at design time, set the Visible-property to false and change it to true when needed.
You can add controls based on the label click in the UserForm code.
You'll have to maintain a count of rows in order to utilize that to position them neatly and to move this label from your example down (otherwise it'll be hidden behind the textboxes you add).
Sample code for the UserForm:
Private rowCount As Integer 'To keep track of rows.
Private Sub UserForm_Initialize()
rowCount = 1
End Sub
Private Sub LabelAddRow_Click() 'Event handler: Add row on click of label.
Dim tb As Control
rowCount = rowCount + 1
Set tb = Me.Controls.Add("Forms.TextBox.1", "textBox" & rowCount & "left", True) 'Add left TextBox.
With tb 'Position and size it:
.Top = 25 + (rowCount * 25) + 10
.Left = 25
.Height = 25
.Width = 100
End With
Set tb = Me.Controls.Add("Forms.TextBox.1", "textBox" & rowCount & "right", True) 'Same for the right one:
With tb
.Top = 25 + (rowCount * 25) + 10
.Left = 150
.Height = 25
.Width = 100
End With
LabelAddRow.Top = LabelAddRow.Top + 25 'Move the label down.
End Sub
You might want to add something to the height of the UserForm too, to make it grow with the added controls. Also you might want to reposition other controls that are below the TextBoxes.
If you want to automatically add rows when the last box has been filled out, you're going to need to add some events to the newly added controls, however that's not the main issue listed in the question.
Edit: The above is obviously based on your last image, since that's the "quick win"; dealing with the events of dynamically added TextBoxes will add additional complexity. If you decide to take that route, I suggest to have a go at this first and post new questions as they come along.
In excel vba I am creating a pivot table and want to fill the header (first two rows) and bottom line (1 row) blue with white font.
The below code fills in the interior of the first data set row rather than the header.
With ActiveSheet.PivotTables(1).TableRange1
.Cells.Borders.LineStyle = xlContinuous
.Range("A3:I4").Interior.ColorIndex = 49
.Range("A13:I13").Interior.ColorIndex = 49
End With
Is there a way to dynamically reference the header and the last line of the pivot table? It would be better to reference "pivot table header" than specific ranges incase values of the report change.
you can simply use this:
With ActiveSheet.PivotTables("PivotTable1")
Debug.Print "full headers at: " & Intersect(.Parent.Range(.TableRange1.Row & ":" & .DataBodyRange.Row - 1), .TableRange1).Address
Debug.Print "last row-range at: " & .TableRange1.Rows(1).Offset(.TableRange1.Rows.Count - 1).Address
End With
but looking at your sub, the easiest way would be to change:
.Range("A3:I4").Interior.ColorIndex = 49
.Range("A13:I13").Interior.ColorIndex = 49
to:
Union(.Rows("1:2"), .Rows(.Rows.Count)).Interior.ColorIndex = 49
There is a dynamic way to address the header rows and the last row:
Dim pvtFirstRow, pvtLastRow As Integer
pvtFirstRow = ActiveSheet.PivotTables(1).TableRange1.row + x ' modify x to the first row where your Pivot data starts
pvtLastRow = ActiveSheet.PivotTables(1).TableRange1.Cells(ActiveSheet.PivotTables(1).TableRange1.Cells.count).row
The code presented in the thread so far does work, but will have to be rerun in future: Any time the number of rows or columns in the pivot changes, you may sit with coloured rows or columns where there is no pivot, or coloured cells in the wrong part of the pivot.
I suggest you look at the built in pivot styles of Excel, pick the one closest to what you need, and use code like this to modify the header row(s) and the grand total row. There is no need to manipulate ranges of cells, because next time you might want to turn off the total row (for argument's sake) but the range will still be coloured.
I recorded a macro and removed all redundant lines of code to help you see what changes. I also remove one useful row (.TintAndShade = ) and replaced it with a "ColorIndex = " statement in order to force the shade of blue you seem to prefer.
After running this, you should have the same style available to all other (existing and new) pivots in the same workbook. You could even make it default. No need to run code again to format when your pivot [refreshed] covers a different range of cells.
You can pick another style one from your own palette and use your own custom name for the copy, as long as you find and replace all relevant strings in the sample code below or record your own actions:
Sub ColourPivotStyleForThisBook()
'duplicate blue/medium pivot style from template
ActiveWorkbook.TableStyles("PivotStyleMedium2").Duplicate ("PivotStyleMedium2v2" _
)
With ActiveWorkbook.TableStyles("PivotStyleMedium2v2")
.ShowAsAvailablePivotTableStyle = True
.ShowAsAvailableTableStyle = False
.ShowAsAvailableSlicerStyle = False
.ShowAsAvailableTimelineStyle = False
End With
'now modify header's style (fill) (font colour is white/automatic already)
With ActiveWorkbook.TableStyles("PivotStyleMedium2v2").TableStyleElements( _
xlHeaderRow).Interior
'only one/two lines are changing the colours
' .TintAndShade = -0.249977111117893
.ColorIndex = 49
End With
'now modify grand total row's style (fill) (font colour is white/automatic already)
With ActiveWorkbook.TableStyles("PivotStyleMedium2v2").TableStyleElements( _
xlTotalRow).Interior
'only one/two lines are changing the colours
' .TintAndShade = -0.249946592608417
.ColorIndex = 49
End With
End Sub
If the result you get is not what you're after, simply select part of a pivot in the workbook, tap the Design tab of the PivotTable Tools ribbon, right-click on the one your code has created (it should be in the Custom section at the top), and click Delete. Hope this helps.
(You can even use code like the above to customise PivotTable styles in other workbooks that don't have PivotTables yet.)
I have table "PriceList" in excel with below structure
Type Thickness width Height Price
iron 5 7 10 20
iron 10 10 15 24
iron 12 14 17 26
how can i find the price if some-one enters type iron, thickness 10, width 9, height 14 using vlookup or macro. i have tried using vlookup but its not works and later on i found on google that Vlookup only retrieve data with one parameter. Can i do this using macro like we do for selecting sheet data using queries
select * from [sheet1$] where col1=x
Please suggest??
Edit: i have calculated the above using this. Now i am calling this macro on sheet change event like below
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 41 Or Target.Column = 43 Or Target.Column = 45 Or Target.Column = 46 Then
Dim i As Currency
i = Calculate_CorePrice(cell(Target.Row, 46).Value, cell(Target.Row, 45).Value, cell(Target.Row, 41).Value, cell(Target.Row, 43).Value, "RWJ Doorset Schedule", "ED15")
cell(Target.Row, 134).Value = i
End If
End Sub
if i debug the function itself with hard-coded values, it is working but if i call the function as in above way, it does not return value and i am not able to debug sheet_change event.
How can i debug this event.
Assuming your columns are A, B, C, etc. You can use an Index/Match formula as an array (enter with CTRL+SHIFT+ENTER).
If the user enters the type, thickness, width, and height in W1, X1, Y1, and Z1, you can use:
=Index($E$2:$E$10,Match(W1&X1&Y1&Z1,$A$2:$A$10&$B$2:$B$10&$C$2:$C$10&$D$2:$D$10,0))
It's convoluted, but basically the Match part is you are looking for W1 in the range A2:A10, then whatever is in X1, you will search B2:B10, etc.
It seems I am just a bit late with my answer and #BruceWayne beat me to it. Still, I will add my solution as well as there is a nice little illustration to it:
Basically, it is the same proposal has been already proposed. Just use an array formula and the & sign to combine all criteria into one. In the end a criteria will look like this iron101015 (for example). And it will be compared to all the combinations in the table.
The best would be to loop through the data, using an if statement to check the data tables. (This could be placed in a sub or in a function depending on how you want the data to be retrieved)
Function GetPrice(Type As String, Thickness As Integer, Width As Integer, Height As Integer)
Dim ItemRow As Range, SearchColumn As Range
'Dim Price As Double 'Use variable if this were a sub
Set SearchColumn = Range(Cells(2,1),Cells(ActiveSheet.UsedRange.rows.count,1))
For Each ItemRow In SearchColumn
If ItemRow.Value = Type AND ItemRow.Offset(0,1).Value >= Thickness AND ItemRow.Offset(0,2).Value >= Width AND ItemRow.Offset(0,3).Value >= Height AND ItemRow.Offset(-1,1).Value < Thickness AND ItemRow.Offset(-1,2).Value < Width AND ItemRow.Offset(-1,3).Value < Height Then
'Price = ItemRow.Offset(0,4).Value
GetPrice = ItemRow.Offset(0,4).Value
Exit For
End If
Next ItemRow
End Function
Edit: Given your comment on another answer, I've adjusted the code to find the value as i believe you are looking for
Wording my question is slightly tricky so I've included screen-shots to make this easier. I have 2 separate spreadsheets which are currently not linked together in anyway. What I've been asked to do is:
For the drop-downs which have a * next to them, have this * drop-down get converted into a acronym (I.e. If it's Home Visit *, then this will be converted to HV), and have it automatically entered into Cell Position X. Please refer to Image 1 then Image 2)
So the user would click on Sheet one, select the relevant drop-down field and then assign how much time that task took. The second sheet would then update itself with this information - it would insert the users name, program and activities. This is where it gets very tricky. Based off the drop-down selection, if it is asterisked (*), then based off the field-type it will convert it into a set acronym which would then be placed in one of the data fields based off the entry date that has been provided.
I designed both spread-sheets and they have macros in the background, but I can't seem to work out how to best perform this. Would you suggest a transpose function which checks firstly the date criteria and then an INDEX(MATCH) function to match the criteria against a pre-defined name-range which converts Home Visit etc. to HV automatically? I'm also unsure of how to insert delimiters for each new entry that is read. If anyone can provide help I would be very grateful.
I'm not 100% sure I understand your question, but here goes:
What about adding a Worksheet_Change event to look for changes in the drop-down's cell, and then converting it to an acronym?
Place the following code inside the sheet of interest:
Private Sub Worksheet_Change(ByVal Target As Range)
'If Cell A1 is changed, put the acronym into A2
If Target.Row = 1 And Target.Column = 1 Then
Cells(2, 1) = GetAcronym(Target.Value)
End If
End Sub
Function GetAcronym(TheText As String) As String
Dim result As String
Dim x As Long
'Always grab the first letter
result = Mid(TheText, 1, 1)
'Get the other letters
For x = 2 To Len(TheText) - 1
If Mid(TheText, x, 1) = " " Then result = result & Mid(TheText, x + 1, 1)
Next x
GetAcronym = UCase(result)
End Function
The questions is bit tricky one, I have googled and got a link http://joelblogs.co.uk/2010/08/13/automatically-create-summary-slides-in-powerpoint-2010/ with VBA code which helps me to insert summary of the titles of all the other slides of one presentation in single parent slide.
The code is working fine, however when the number of slides with titles is more than 30 or 50 then the Table of content parent slide cannot hold the entire title names as the names will be hidden and go beyond the slide presentation.
Hence, I like to confirm are there any VBA code to distribute the contents of the summary names in to three columns through VBA in the table of contents slide ?
Based on the link where you have an example you need to add that code at the and of your macro:
With summary.Shapes(2).TextFrame2
.Column.Number = 3
End With
which set 3 columns in your summary text frame.
Remember, that you could need to set font size, too, to keep your text within text box.
Additional information: What I see is that font size changes (decrease) as long as you put more text into summary Shape (Shapes(2) in my example). You could then trace the font size to check if you should increase number of columns. Here is an example:
With summary.Shapes(2).TextFrame2
If .TextRange.Font.Size < 20 Then
'additionally check here if max approved column numbers is not exceeded.
.Column.Number = .Column.Number + 1
End If
End With
And here is my full basic test code (which could be run for any new empty presentation):
Sub test_loop()
Dim summary As Slide
Set summary = ActivePresentation.Slides.Add(1, ppLayoutText)
Dim enterText as string
Do
enterText = InputBox("Additional text to insert into Shape:")
With summary.Shapes(2).TextFrame2
.TextRange.Text = .TextRange.Text & Chr(10) & enterText
If .TextRange.Font.Size < 20 Then
.Column.Number = .Column.Number + 1
End If
End With
Loop While enterText <> ""
End Sub