I'm having some problems using VBA in Excel to create charts using dynamic ranges. What I need to do is chart the results of each of the compounds for each sample. Both the number of samples and the number of compounds can vary. An example of the datasheet can be found here.
A sample of the code I tried to write, however my range has not been properly defined:
Sub Graph()
Dim r As Range
Dim c As Range
Dim wks As Worksheet
Set wks = ActiveSheet
'
' Graph Macro
'
Set r = Range("B2").End(xlDown)
Set c = Range("D2").End(xlToRight)
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("wks!$B$2:B" & r, "wks!$P$2:P" & c)
'
End Sub
Could anyone point me in the right direction?
Try this sub instead:
Sub Graph()
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
With [a1].CurrentRegion
ActiveChart.SetSourceData Source:=Range(.Resize(, 1).Offset(, 1), .Offset(, 3).Resize(, .Columns.Count - 3))
End With
End Sub
Related
I'm really stumped with converting Index + Match to VBA. I'm very new to VBA, this is proving to be beyond my abilities.
I have a table in Sheet2 With Columns, 'Case', 'Probability', 'Impact' & 'Severity'. Then a Matrix in Sheet1
My formula (filled down the column) is:
=IFNA(INDEX(Sheet1!$C$2:$G$6,MATCH([#Probability],Sheet1!$B$2:$B$6,0),MATCH([#Impact],Sheet1!$C$1:$G$1,0)),"")
I'm trying to auto-populate 'Severity' in the table based on the values in the Matrix
Table
Matrix
I tried using Application.WorksheetFunction but I don't get any results.
Any advice would be much appreciated.
VBA Using INDEX/MATCH Formula
These will populate the values instead of the formulas.
If you remove the line .Value = .Value, the formulas stay.
Adjust the worksheet and table names.
Option Explicit
Sub TestEdu()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet2") ' adjust
Dim tbl As ListObject: Set tbl = ws.ListObjects("Table1") ' adjust
Dim lcl As ListColumn: Set lcl = tbl.ListColumns("Severity")
With lcl.DataBodyRange
.Formula = "=IFNA(INDEX(Sheet1!$C$2:$G$6,MATCH([#Probability]," _
& "Sheet1!$B$2:$B$6,0),MATCH([#Impact],Sheet1!$C$1:$G$1,0)),"""")"
.Value = .Value
End With
End Sub
Sub TestCompact()
With ThisWorkbook.Worksheets("Sheet2").ListObjects("Table1") _
.ListColumns("Severity").DataBodyRange
.Formula = "=IFNA(INDEX(Sheet1!$C$2:$G$6,MATCH([#Probability]," _
& "Sheet1!$B$2:$B$6,0),MATCH([#Impact],Sheet1!$C$1:$G$1,0)),"""")"
.Value = .Value
End With
End Sub
I'm looking to pull cells with certain text across multiple worksheets and put it into a new worksheet. I'm stuck on creating a loop, or just general code, that would let me use what I have across more than one worksheet.
Here's my code:
Sub EnzymeInteractions()
' Copy EPC cells Macro
Dim bottomL As Integer
Dim x As Integer
bottomL = Sheets("Enzyme Interactions (110)").Range("I" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Enzyme Interactions (110)").Range("I:I" & bottomI)
If c.Value = "EPC" Then
c.EntireRow.Copy Worksheets("sheet4").Range("A" & x)
x = x + 1
End If
Next c
' CombineColumns Macro
Dim rng As Range
Dim iCol As Integer
Dim lastCell As Integer
Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1
For iCol = 2 To rng.Columns.Count
Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
ActiveSheet.Paste Destination:=Cells(lastCell, 1)
lastCell = lastCell + rng.Columns(iCol).Rows.Count
Next iCol
' RemoveBlanks Macro
Cells.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Range("A9").Select
End Sub
Everything works perfectly aside from the fact I don't know how to use this marco across multiple worksheets (about 10).
You can add a parameter to your sub and pass in each worksheet to be processed as an argument.
sub Main()
EnzymeInteractions Sheets("Enzyme Interactions (110)")
EnzymeInteractions Sheets("Enzyme Interactions (120)")
'etc
End sub
Sub EnzymeInteractions(ws As Worksheet)
'use ws instead of (eg) Sheets("Enzyme Interactions (110)")
End Sub
You do need to fix the second half of your sub to remove the use of ActiveCell/ActiveSheet: you should always use explicit range/sheet references where you can.
See: How to avoid using Select in Excel VBA
for guidelines on that.
I am using the AdvancedFilter property of a Range object to copy a unique set of values to another range within my workbook. Unfortunately, the ActiveSheet has an autofilter applied and the AdvancedFilter statement removes the autofilter from the ActiveSheet.
As you will see in my code below I can add the autofilter back onto the ActiveSheet but this feels a little 'clunky'.
Could anyone suggest an alternative coding solution?
Sub mmDropDownClasses()
'Populate the 'LU' sheet with a unique range of classes from the currently
'active sheet
Range("LU!I2:I30").ClearContents 'Clear the range to be populated
ActiveSheet.Unprotect 'Unprotect the active sheet
'Extract the unique values from a range on the active sheet and copy them
'to a range on the 'LU' sheet
ActiveSheet.Range("C6:C304").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range("LU!I2"), Unique:=True
'Reinstate the autofilter deleted by the advancedfilter in the previous
'statement
ActiveSheet.Range("A5:BA5").AutoFilter
ActiveSheet.Protect AllowFiltering:=True 'Protect the active sheet
'Sort the range on the 'LU' sheet
Range("LU!I2:I30").Sort key1:=Range("LU!I2:I30"), order1:=xlAscending
End Sub
Here's an example of Dictionary use:
Sub testit()
Dim v
v = UniqueListFromRange(ActiveSheet.Range("C6:C304"))
Sheets("LU").Range("I2").Resize(UBound(v) + 1).Value = Application.Transpose(v)
End Sub
Public Function UniqueListFromRange(rgInput As Range) As Variant
Dim d As Object
Dim rgArea As Excel.Range
Dim dataSet
Dim x As Long
Dim y As Long
Set d = CreateObject("Scripting.Dictionary")
For Each rgArea In rgInput.Areas
dataSet = rgArea.Value
If IsArray(dataSet) Then
For x = 1 To UBound(dataSet)
For y = 1 To UBound(dataSet, 2)
If Len(dataSet(x, y)) <> 0 Then d(dataSet(x, y)) = Empty
Next y
Next x
Else
d(dataSet) = Empty
End If
Next rgArea
UniqueListFromRange = d.keys
End Function
I'm trying to make a macro that will run through an excel sheet and go through a set of rows and make a graph for each row.
I've got a bit of code that kind of does what I need, but puts it all on one graph when I need an individual graph for each row.
`Dim i As Integer
Dim ws As Worksheet
Set ws = Sheets("Master Sheet")
For Row = 1 To 20
Dim my_cell
Dim rng As Range
Set rng = Sheets("Master Sheet").Range("J8:Y8")
For Each my_cell In rng
If my_cell <> "" Then
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Master Sheet'!$J$8:$Y$8")
ActiveChart.ChartType = xlLineMarkers
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveSheet.Activate
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).XValues = "='Master Sheet'!$J$2:$Y$2"
ActiveChart.SeriesCollection(1).Name = "=""FP"""
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""Progress"""
ActiveChart.SeriesCollection(2).Values = _
"='Master Sheet'!$J$8,'Master Sheet'!$AF$8:$AH$8"
ActiveChart.DisplayBlanksAs = xlInterpolated
ActiveSheet.Activate
ActiveChart.ChartArea.Select
Else
Exit For ' Blank cell found, exiting
End If
Next
Next Row
End Sub`
If anyone can give me a hand to see where I'm going wrong that would be great.
Not really sure you have structured your For Next and For Each loops well. Ideally you'd like to step through ranges and actually use the value you define in your For Each statement. Without seeing your workbook I just adapted a small range of data to simulate creating a graph.
I just took your same code and generate a graph on the same worksheet for each row of numbers. You can take these principles and apply it to your logic.
Sub test()
Dim Row As Integer
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") 'Change this to: Set ws = Sheets("Master Sheet")
For Row = 1 To 6
Set rng = ws.Range("B1:D1").Offset(Row, 0) 'Change to (I'm guessing here): ws.Range("$J$7:$Y$7").Offset(Row, 0)
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(ws.Name & "!" & rng.Address)
ActiveChart.ChartType = xlLineMarkers
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).XValues = "='Sheet1'!$B$1:$D$1" 'Change to "='Master Sheet'!$J$2:$Y$2"
ActiveChart.SeriesCollection(1).Name = ws.Range("A1").Offset(Row, 0).Value 'Change this to whatever you want to name the graphs. This is currently set to dynamicly name each graph by the series name set in Column A.
'ActiveChart.Location Where:=xlLocationAsNewSheet 'uncomment this line to put on new sheet
'ws.Select 'Need to go back to worksheet
Next Row
Set ws = nothing
Set rng = nothing
End Sub
Here are a couple links that may help;
Creating and positioning graphs in a for loop VBA and
Excel VBA: Chart-making macro that will loop through unique name groups and create corresponding charts?
Google also has many other links.
If I've misunderstood your question or need anything else please let me know.
Cheers
I'm trying to write a macro to create graphs in excel 2007. I don't know the number of cells that will be in the range for one of the series of data (it could be anywhere from 50 - 1000). I've googled this and I've found answers but they are all over the map and the few I've tried haven't helped me at all.
I'm a newb at vba macros but am an experienced programmer.
I've found examples such as:
Sub FindLast2()
x = ActiveSheet.UsedRange.Rows.Count
ActiveCell.SpecialCells(xlLastCell).Select
End Sub
I'm not sure if this works & if it does work how would I incorporate that into my macro
Here's my macro as it stands now:
Sub temp_graph_5()
'
' temp_graph_5 Macro
'
'
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(2).Select
Sheets(2).Name = "Temperature"
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets(1). _
Range("B2:B324")
ActiveChart.SeriesCollection(1).Name = "=""Temperature"""
End Sub
The 'B324' is the section that I need to be variable.
Any help is greatly appreciated.
This code may help achieve what you need:
Sub temp_graph_5()
Dim myRng As Range
Dim lastCell As Long
//Get range to be plotted in chart
lastCell = Worksheets(1).Range("B2").End(xlDown).Row
Set myRng = Worksheets(1).Range("B2:B" & lastCell)
//Add worksheet and name as "Temperature"
Dim newSheet As Worksheet
Set newSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
newSheet.Name = "Temperature"
newSheet.Select
//Add a new chart in Temperature and plot values from sheet 1
Charts.Add
With ActiveChart
.ChartType = xlLine
.SetSourceData Source:=myRng, PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:="Temperature"
End With
End Sub
sub test()
last_row_all = Range("A65536").End(xlUp).Row
msgbox last_row
end sub