I am working on a macro to set chart max and mins based on a dynamic data set. When the user chooses their group, the chart updates, and the macro runs to update the chart max and min values to an appropriate scale.
I am hoping someone can help me as I try to use variables from 3 ranges to:
Choose chart based on cell value in range
Set min based on cell value in range
Set max based on cell value in range
At this point I am able to pull out the chart name, but am having trouble getting the value for min and max from the range.
Any help would be appreciated!
Sub rescale()
ActiveSheet.Calculate
Dim ChrtNmRng As Range
Dim ChrtMinRng As Range
Dim ChrtMaxRng As Range
Dim cell As Range
Set ChrtNmRng = Sheets("Data").Range("o5:o20")
Set ChrtMinRng = Sheets("Data").Range("z5:z20")
Set ChrtMaxRng = Sheets("Data").Range("Aa5:Aa20")
For Each cell In ChrtNmRng
With Sheets("Dashboard").ChartObjects(cell.Value).Chart.Axes(xlValue)
.MinimumScale = ChrtMinRng.Value
.MaximumScale = ChrtMaxRng.Value
End With
Next cell
End Sub
Do it like this:
Sub rescale()
Dim ChrtNmRng As Range, cell As Range
ActiveSheet.Calculate
Set ChrtNmRng = Sheets("Data").Range("o5:o20")
For Each cell In ChrtNmRng
With Sheets("Dashboard").ChartObjects(cell.Value).Chart.Axes(xlValue)
.MinimumScale = Range("Z" & cell.Row)
.MaximumScale = Range("AA" & cell.Row)
End With
Next cell
End Sub
The key here is that your ranges for the minimum and maximum values (Z and AA) line up precisely with column O so you can use the row reference to get the corresponding values you need.
As I understand your comments. Column O contains the name of the charts and the others contain what is wanted as the min and max for each of those charts.
Sub rescale()
ActiveSheet.Calculate
Dim ChrtNmRng As Range
Dim ChrtMinRng As Range
Dim ChrtMaxRng As Range
Dim i As Long
Set ChrtNmRng = Sheets("Data").Range("o5:o20")
Set ChrtMinRng = Sheets("Data").Range("z5:z20")
Set ChrtMaxRng = Sheets("Data").Range("Aa5:Aa20")
For i = 1 To 16
With Sheets("Dashboard").ChartObjects(ChrtNmRng(i).Value).Chart.Axes(xlValue)
.MinimumScale = ChrtMinRng(i).Value
.MaximumScale = ChrtMaxRng(i).Value
End With
Next i
End Sub
Related
Have a sheet with a list of Cell references in two columns.
Trying to create a macro that pulls these into a range and uses the first cell in column A for the start point of an autoshape line and the second cell in column B as the end point of an autoshape line.
The script is working and doing what I want it to however at the end of execution I am getting "Subscript out of range error"
What am I doing wrong?
rng = Range("A1:B100")
Worksheets("Map").Activate
For Each row In rng
i = i + 1
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Range(rng(i, 1)).Left, Range(rng(i, 1)).Top, Range(rng(i, 2)).Left, Range(rng(i, 2)).Top).Select
Next row
Avoid select and activate, declare all the variables and loop only from the rows of the range:
Sub TestMe()
Dim rng As Range
Set rng = Worksheets("Map").Range("A1:B100")
Dim row As Range
Dim i As Long
For Each row In rng.Rows
i = i + 1
Worksheets("Map").Shapes.AddConnector msoConnectorStraight, _
row.Cells(i, 1).Left, _
row.Cells(i, 1).Top, _
row.Cells(i, 2).Left, _
row.Cells(i, 2).Top
Next row
End Sub
How to avoid using Select in Excel VBA
The Range("A1:B100") has no connection to Worksheets("Map") beyond a possible coincidence that Worksheets("Map") was the active worksheet. Provide proper parent worksheet reference.
You Set objects like ranges to their vars.
Don't Select the connectors you create; not in a loop, not ever.
with Worksheets("Map")
set rng = .Range("A1:B100")
For Each row In rng
i = i + 1
.Shapes.AddConnector msoConnectorStraight, _
.Range(rng(i, 1)).Left, .Range(rng(i, 1)).Top, _
.Range(rng(i, 2)).Left, .Range(rng(i, 2)).Top
Next row
end with
I am trying to figure out how to add some cell values together from different sheets but I don't know what the cells references are as they vary!
Basically the values i need will appear 2 rows below some certain text. So I was looking for a formula that searches multiple sheets, finds the specific text, goes 2 rows below then adds the values together.
Here's something I hope you can adapt to your situation by changing the sheet and row and column range, the text to look for, and the destination of the total.
Sub findfvalues()
Dim rowValue
Dim total
total = 0
For r = 1 To 25 'update this to suit your needs
For c = 1 To 25 'update this to suit your needs
If Cells(r, c).Value = "f" Then 'update "f" to search for what you want
rowValue = r + 2
total = total + Cells(rowValue, c).Value
End If
Next
Next
Cells(30, 1).Value = total 'update this to suit your needs
End Sub
So we just check every cell for the "f" and if we find it, we add the value to a running total. Display the total at the end.
This will look in each worksheet, and if your text is found, add the value that's two rows below to a running total:
Sub find_Values()
Dim ws As Worksheet
Dim findStr As String
Dim foundCell As Range
Dim total As Long
findStr = "my Text"
For Each ws In ActiveWorkbook.Worksheets
Set foundCell = ws.Cells.Find(what:=findStr)
If Not foundCell Is Nothing Then
total = total + foundCell.Offset(2, 0).Value
End If
Next ws
Debug.Print "The value is: " & total
End Sub
I am attempting to Loop through a Column K starting at row 14 until the end. I have written the following code, but it stops working at the Range("K14:") line. I tried using Range("K14"& Rows.Count) but that didn't help either.
Windows("Price VolatilityDM.xlsm").Activate
Sheets("Volatility Static Data").Activate
Dim x As Single
Dim Cell As Range
For Each Cell In Range("K14:")
If Cell.Value > 0.25 Then
Sheets("Volatility Static Data").Range("B:K").Copy
Windows("Tolerance ReportDM.xslm").Activate
Sheets("Sheet1").Range("K17:Q17").Paste
End If
Next Cell
Windows("Price VolatilityDM.xlsm").Activate
Sheets("Volatility Static Data").Activate
Set sh = ThisWorkbook.Workheets("Volatility Static Data") ' add a reference to the sheet for simplicity
Dim x As Single
Dim Cell As Range
Dim lastRow
lastRow = sh.Cells(sh.Rows.Count, "K").End(xlUp).Row ' get the last row
For Each Cell In Range("K14:K" & lastRow)
If Cell.Value > 0.25 Then
Sheets("Volatility Static Data").Range("B:K").Copy
Windows("Tolerance ReportDM.xslm").Activate
Sheets("Sheet1").Range("K17:Q17").Paste
End If
Next Cell
You just need to find the end of the Range object and make sure you iterate over to that. See above; if there are any questions, let me know.
It stops there because you haven't completed writing the whole range. "K14:" is invalid syntax. For example, you could do: "K14:K" & LastRow
you can use something like this to find the end of column K starting at 14:
dim end as range
set cell = range("K14")
'go down one cell at a time until you find that
'the next one is empty. This is the end of the column
do while not cell.offset(1,0).value = ""
set cell = cell.offset(1,0)
loop
set end = cell
and then use for each cell in range("K14:" & end.address)
In your code it'd look like this:
Windows("Price VolatilityDM.xlsm").Activate
Sheets("Volatility Static Data").Activate
Dim x As Single
Dim Cell As Range
dim end as range
set cell = range("K14")
'go down one cell at a time until you find that
'the next one is empty. This is the end of the column
do while not cell.offset(1,0).value = ""
set cell = cell.offset(1,0)
loop
set end = cell
For Each Cell In Range("K14:" & end.address)
If Cell.Value > 0.25 Then
Sheets("Volatility Static Data").Range("B:K").Copy
Windows("Tolerance ReportDM.xslm").Activate
Sheets("Sheet1").Range("K17:Q17").Paste
End If
Next Cell
Dim range_row_aa As Range
Set range_row_aa = Worksheets("Accretion Amort").Range("1:1")
Dim name_column As Range
Set name_column = Worksheets("Accretion Amort").Columns("A:Z")
Dim column_x As Object
For Each column_x In range_row_aa
If column_x = "Balance Change Diff" Then
Sheets("Recon").Range("J3") = "OKKKKK"
End If
Next
If the column on the accretion amort sheet equals balance change diff, I would like to copy/extract the data in that column to the recon sheet.
Would an array be more helpful in this scenario? Perhaps, a function, as I plan to analyze each column in the accretion amort sheet and extract the column data if the column title (all column titles are in row 1) satisfies a criteria.
(Please note the print "OKKKKK" statement is merely a placeholder to test if the For/IF loop worked)
Here is some code that loops through Row 1:
Sub loopThroughRow1()
Dim range_row_aa As Range
Set range_row_aa = Worksheets("Accretion Amort").Rows("1:1")
Dim cell As Object
For Each cell In range_row_aa.Cells
If cell.Value = "Balance Change Diff" Then
Sheets("Accretion Amort").Range("J3") = cell.Address
End If
Next
End Sub
I've used cell.address as the placeholder so we know it finds the last instance of "Balance Change Diff"
This will use the clipboard to move values to the second sheet:
Sub loopThroughRow1()
Dim range_row_aa As Range
Set range_row_aa = Worksheets("Accretion Amort").Rows("1:1")
Dim x As Integer
Dim cell As Object
For Each cell In range_row_aa.Cells
If cell.Value = "Balance Change Diff" Then
cell.EntireColumn.Copy
x = Sheets("recon").Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("recon").Cells(1, x + 1).PasteSpecial Paste:=xlPasteValues
End If
Next
End Sub
I begin the process of streamlining the work, so...
I need a VBA code that copy only the cells with value, within a range specified, to ONE column. I want that the effect will be immediate. Once I insert data the column will be update.
example:
copy only the cells with numbers, within a range A2:D9, to column F.
in the real VBA code I don't want it to be limited to a small range, because I have more column then A-D, and they long then 9 rows. So if I could define it a range (but in the code and not in new pop-up windows), this would be an excellent :)
the COLORS and column G are meaningless. This is just for example.
Screenshot:
Thank you for your patience and time...
Appreciate it very much !
Do it like this:
Sub Macro1()
'
' Macro1 Macro
'
Dim SourceRange As Range
Dim TargetRange As Range
Dim addedCells As Integer
'
Application.Calculation = xlManual
Set TargetRange = Range("F2:F34")
addedCells = 0
Set SourceRange = Range("A2:D9")
For Column = 1 To SourceRange.Columns.Count
For Row = 1 To SourceRange.Rows.Count
If Not (SourceRange.Cells(Row, Column) = "") Then
addedCells = addedCells + 1
TargetRange.Cells(addedCells, 1) = SourceRange.Cells(Row, Column)
End If
Next Row
Next Column
Calculate
Application.Calculation = xlAutomatic
End Sub
Add some parameters to make it dynamic.