I'm trying to use VBA to create a stacked column graph using 3 columns of data out of a large ~30 column named table in excel. The desired outcome would be a stacked column graph, where the columns are based on the column "Program" (there are 5 distinct values across ~200 rows) and the numbers that make up the columns are the "SAVINGS - USE THIS" with the corresponding "Project Number"s as those chunks labels. Each row is a distinct project.
For instance, if I have 5 projects in "Program 1," I would want the "SAVINGS - USE THIS" values stacked on top of each other and when a run my mouse over the portions of the column the Project Number would show.
I am fairly new to VBA and am currently editing my previous code to make the project numbers and their savings into a pie graph (originally I didn't care about the program), so if there is a better way to do any of this please let me know.
Sub CreateChart()
Dim labelRng As Range
Dim dataRng As Range
Dim progRng As Range
Dim chtRng As Range
Dim cht As Object
Dim mySeries As Series
Dim vntValues As Variant
Dim i As Integer
Set chtRng = Union(Sheets("CMF").ListObjects("CMF").ListColumns("Program").Range, _
Sheets("CMF").ListObjects("CMF").ListColumns("Project Number").Range, _
Sheets("CMF").ListObjects("CMF").ListColumns("SAVINGS - USE THIS").Range)
'Set progRng = Sheets("CMF").ListObjects("CMF").ListColumns("Program").Range
'Set labelRng = Sheets("CMF").ListObjects("CMF").ListColumns("Project Number").Range
'Set dataRng = Sheets("CMF").ListObjects("CMF").ListColumns("SAVINGS - USE THIS").Range
'Set chtRng = Union(progRng, dataRng, labelRng) 'Sets range for pie
Set cht = Sheets("CMF").Shapes.AddChart2 'Creates chart
For j = cht.Chart.SeriesCollection.Count To 1 Step -1 'Had to be added to avoid errors
cht.Chart.SeriesCollection(j).Delete
Next j
cht.Chart.SetSourceData chtRng 'Sets data range for chart
cht.Chart.ChartType = xlColumnStacked
If this is the best way to do this, my current issue is defining the data range for the graph. You can see I am trying a couple different things, but the problem I'm having is that instead of pulling the "Program" column it is pulling the column that is next to it.
For reference, Project Number is in Column A, Program is in Column C and SAVINGS is in column X. It is pulling Columns A, B and X. Even if I specify the column number as "3" or pull them in a different order, I always have the same issue. The only way I don't have the issue is if I stop pulling in the Project Number and just pull in Program and Savings, which it gets right.
What am I doing that is causing it to pull back the wrong column of data, and once I get the right data in how can I make the stacked columns be organized by Program?
Thanks for reading all of that!
Since you are just assigning SetSourceData at the end, excel is going to do what it thinks is best...which isn't what you want in this case.
Try creating the different Series one at a time and assigning the ranges for each individually after you delete them. Just use the Macro Recorder to go over all the steps that you need to do to create the chart from scratch.
Related
This is proper basic but I'm struggling here. I need the range of rows of a data source in a graph to extend or retract by a value I have in "J5". "J5" changes dynamically and I can use a call function for it to work in the graph. Because of the way the charts are set up it has to be this way. My code so far is:
Sub Updatecodelengh()
Dim i As Integer
Dim G As Worksheet
Set G = Sheet1
i = G.Range("J5")
ActiveSheet.ChartObjects("GanttChart").Activate
ActiveChart.SeriesCollection(16).Values = "='Gantt'!$L$3:$L$4"
End Sub
Where it says "='Gantt'!$L$3:$L$4" I need the range of the chart data to start on $L$3 and extend downwards by the value obtained in J5. Thanks for any help
Do you mean simply
ActiveChart.SeriesCollection(16).Values = "='Gantt'!$L$3:$L$" & i
However, you should check if J5 contains a valid number to prevent runtime errors.
A small hint: When dealing with row and column numbers in VBA, always use datatype long.
I am working on an excel workbook where the user imports text files into a "Data Importation Sheet", the amount of text files imported is dynamic. See image.
So here is what I need to happen
1) Need to find the most up-to-date Reading Date (in this example 2016)
2) Need to copy and paste the range of Depth values of the most up-to-date Reading Date to a separate sheet (in this example I would want to copy and paste values 1-17.5.
3) Need to check if all other data sets contain this same range of Depth values. For the year 2014 you can see its depth goes from 0.5-17.5. I want to be able to just copy the data at the range of the most up-to-date Reading Date so the range of 1-17.5.
Here is my code to find the most up-to-date Reading date and to copy those depths to the other sheets.
Sub Copy_Depth()
Dim dataws As Worksheet, hiddenws As Worksheet
Dim tempDate As String, mostRecentDate As String
Dim datesRng As Range, recentCol As Range, headerRng As Range, dateRow As Range, cel As Range
Dim lRow As Long
Dim x As Double
Set dataws = Worksheets("Data Importation Sheet")
Set hiddenws = Worksheets("Hidden2")
Set calcws = Worksheets("Incre_Calc_A")
Set headerRng = dataws.Range(dataws.Cells(1, 1), dataws.Cells(1, dataws.Cells(1, Columns.Count).End(xlToLeft).Column))
'headerRng.Select
For Each cel In headerRng
If cel.Value = "Depth" Then
Set dateRow = cel.EntireColumn.Find(What:="Reading Date:", LookIn:=xlValues, lookat:=xlPart)
Set datesRng = dataws.Cells(dateRow.Row + 1, dateRow.Column)
'datesRng.Select
' Find the most recent date
tempDate = Left(datesRng, 10)
If tempDate > mostRecentDate Then
mostRecentDate = tempDate
Set recentCol = datesRng
End If
End If
Next cel
Dim copyRng As Range
With dataws
Set copyRng = .Range(.Cells(2, recentCol.Column), .Cells(.Cells(2, recentCol.Column).End(xlDown).Row, recentCol.Column))
End With
hiddenws.Range(hiddenws.Cells(2, 1), hiddenws.Cells(copyRng.Rows(copyRng.Rows.Count).Row, 1)).Value = copyRng.Value
calcws.Range(calcws.Cells(2, 1), calcws.Cells(copyRng.Rows(copyRng.Rows.Count).Row, 1)).Value = copyRng.Value
Worksheets("Incre_Calc_A").Activate
lRow = Cells(Rows.Count, 1).End(xlUp).Row
x = Cells(lRow, 1).Value
Cells(lRow + 1, 1) = x + 0.5
End Sub
Any tips/help would be greatly appreciated. I am fairly new to VBA and don't know how to go about comparing the depth ranges! Thanks in advance!
Assuming that your datasets are as regularly organised as your screenshot suggests then quite a lot of processing can be done in Excel.
The image below shows a possible approach based on the data shown in your example.
The approach exploits the fact that each data set occupies 7 columns of the importation worksheet. The =ADDRESS() function is used to build text strings which look like cell addresses and these are further manipulated to create text strings which look like range addresses. The approach also assumes that the reading date is always located in the third row following the final row of depth data.
The solution is slightly different to your problem, in that it identifies the common range of depth values across all datasets. For the example in the question this amounts to the same thing as identifying the depth values associated with the latest reading date.
This approach was taken as it is not clear from the question what would happen if, say, a dataset had depth values starting at say 1.5 (so greater than the first value for the latest reading date) or ending at say 17 (so less than the the last value for the latest reading date). The approach can obviously be adapted if these possibilities will never occur.
The table shown in the image above has in its final column, a text representation of the ranges to be copied from the Data Importation Sheet. A simple bit of VBA can read this column, a cell at a time and use the text to assign an appropriate range object to which copy and paste methods can then be applied.
Additional bit of answer
The image above could be set-up as a "helper" worksheet. If there is always the same number of datasets on the Data Importation Worksheet then set up this helper sheet so that the number of rows in Table 2 is equal to this number of datasets. If the number of datasets is variable, then set up the helper sheet so that the number of rows in Table 2 is equal to the maximum number of datasets that is ever likely to be encountered. In this situation, when the number of datasets imported is fewer than this maximum, some rows of Table 2 will be unused and these unused rows will contain meaningless values in some columns.
Your VBA program should be organised to read the value in the value in cell D2 of the helper sheet and then use this to determine how many rows of Table 2 to examine with the rest of your VBA code. This will unused rows (if any) to be ignored.
If your VBA code identifies a value of, say 10, in cell D2 of the helper sheet then you will want your code to read one a time the 10 values in the range Q12:Q21 (so in a loop). Each of these cells holds, as a string, the range containing a single dataset's values and so can be assigned to a Range object using code such as
Set datasetRng = Range(datasetStr)
where datasetStr is the text string read from a cell in Q12:Q21.
Still within the loop, datasetRng can then be copied and pasted to your output worksheet.
Because the same helper worksheet can be re-used for each data importation, you should be able to incorporate it into your automation scheme. No need for copying and pasting formula down rows to create a different helper for each importation, just apply the same helper template to each data importation.
The approach adopted makes as much use of Excel as possible to determine relevant information about the imported data sets and summarises this information within the helper worksheet. This means VBA can be limited to automation of the copy/paste operations on the datasets and its reads information from the helper sheet in determining what to copy for each dataset.
It is of course possible to do everything in VBA but as you indicated you were fairly new to VBA it seemed sensible to tip the balance towards using less VBA and more Excel.
Incidentally, the problem of comparing the depth ranges is not really one of Excel or programming, it is one of analysis - ie looking at a range of cases, figuring out what needs to happen for each case, and distilling this into a set of processing rules (what some would call an algorithm). Only then should attempts be made to implement these processing rules (either via Excel formula or VBA code). I have hinted at my analysis of the problem (finding the common range of depth values across all datasets)and you should be able to track through how I have implemented this in Excel to cater for cases where some datasets might contain Depth values which are less than the minimum of the common range or which are greater than its maximum (or possibly both).
End of additional bit
The formula used are shown in the table below.
I have used the various methods pointed out in this forum and none seem to work, so I will try to be more specific.
I have a workbook called LIBRARY.xlsm.
This workbook contains two worksheets: CALCULATOR and CUTS.
The worksheet CALCULATOR contains two tables: INPUT and OUTPUT.
I enter data into INPUT, values are calculated and automatically entered into OUTPUT.
I create a button below OUTPUT with macro to copy data in OUTPUT to worksheet CUTS.
I enter new data into INPUT, which then updates OUTPUT.
Now I want to copy this new data to CUTS without overwriting or deleting previous data.
Since this project is divided into 5 sections, I should end up with five tables in the worksheet CUTS that I can then print out.
The INPUT table encompasses cells A1:M31, which does not matter (I’m not copying this).
The OUTPUT table occupies cells O6:S26. This is the data that needs to be copied.
Placement into worksheet CUTS can start at cell A1 (which means the table will have the range A1:E20). I would like to skip a column and then place the next data set. Thus, the next data set should begin at G1 (G1:K20), then at M1:Q20 and so forth). Maybe only go three tables across and then start next three below (separated by row).
Here is the code tried to use. Problem is, it does not retain the values and it overwrites the previous data.
Sub Create_CUTS ()
Dim sourceSheet As Worksheet
Dim sourceRange As Range
Dim sourceRows As Integer
Set sourceSheet = Worksheets("CALCULATOR")
sourceRows = WorksheetFunction.CountA(sourceSheet.Range("A:A"))
Set sourceRange = sourceSheet.Range("O6:S26" & sourceRows)
Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetRows As Integer
Set targetSheet = Worksheets("CUTS")
targetRows = WorksheetFunction.CountA(targetSheet.Range("A:A"))
Set targetRange = targetSheet.Range("A" & targetRows + 1 & ":A" & targetRows + 1 + sourceRows)
sourceRange.Copy Destination:=targetRange
End Sub
Thank you, everyone
-Grumps
There are a few ways to do this. The easiest is probably to just reference the usedrange of the target sheet to know where you left off with the last paste.
lastUsedRow = targetSheet.UsedRange.Rows.Count
lastColumnUsed = targetSheet.UsedRange.Columns.Count
Then you just add a column or row and paste the table in the new location. If the column count is 22 or greater, add a row and paste at "A" and the lastUsedRow + 2. There is some potential for this to be wrong if the sheets are saved with cells that are empty, but excel reads them as "used" (somehow people I work with manage to do this all the time, I don't even know how they do it). It sounds like this is something that users won't be manipulating, so I wouldn't think that would be a problem, but if it is a possible problem for you, you can use a loop to find the next empty cell instead of using the built in "usedrange" collection.
I am trying to determine how I can have a user insert columns and/or rows without it impacting the rest of the code in the macro.
Defining names for my objects and using r1c1 references in VBA does not seem to help as these inserted columns shift those references and names as well.
Am I missing something that should be completely obvious???
Or is what I am trying to accomplish not possible?
UPDATE: When I name a range in excel (without VBA) everything seems to work fine with inserted columns. However, when I name the range with VBA everything messes up. Here is a sample of some code to work with.
When this below code is run... I am not able to insert columns as my MSGBOX's don't realize the named cell has shifted to the right. HOWEVER, if I were to remove the first line in this code and just name the cell "GanttStartLocation" which is quoted out in the code... this seems to work fine.
WHY DOES THiS NOT WORK WHEN NAMED WITH VBA????
ActiveWorkbook.Names.Add Name:="DEFINENAMETEST", RefersToR1C1:="=Sheet1!R10C14"
Dim rGanttLocation As Range 'Range used to define where the Gantt chart begins
Dim iFirstRowGantt As Integer 'Defines the first row of the Gantt chart based on rGanttLocation
Dim iFirstColumnGantt As Integer 'Defines the first column of the Gantt chart based on rGanttLocation
'Set rGanttLocation = Worksheets(1).Range("GanttStartLocation")
Set rGanttLocation = Worksheets(1).Range("DEFINENAMETEST")
iFirstRowGantt = rGanttLocation.Row
iFirstColumnGantt = rGanttLocation.Column
MsgBox (iFirstRowGantt)
MsgBox (iFirstColumnGantt)
Use a named range for your cells so that addition of rows/columns are less likely to impact your code if rows/columns are added inside the range. For example: if D1-F10 was called testrange, executing the following subroutine will give red background color to the range
Public Sub Test()
Range("testrange").Interior.Color = vbRed
End Sub
If a new row and column are added to this range, and the subroutine is re-executed after replacing vbRed with vbYellow, the entire range (with new column and row) will turn yellow.
Outside of the named range, it's going to take decent amount of work to keep your Macro's generic, from what I understand.
Hello everyone alright let start by giving some brief background on my project then I will follow up with my specific issue and code.
Currently I am building a program to automate the process of filling a template. This template exceeds 60,000 rows of data quite often and I've built the large majority of it to work month to month by plugging in new data sheets and running it. Currently all of the work is based off of one data sheet which I import into excel manually. This data sheet does not contain all the data I need to populate the template so now I am beginning to bring in additional data to supplement this. The problem herein lies with data association. When I was originally pulling from one data sheet I didn't have to worry if the data I pulled for each row coincided with the other rows because it all came from the same sheet. Now I have to cross check data across two sheets to confirm it is pulling the correct information.
Now for what you need to know. I am trying to fill a column that will be referred to as Haircut, but before I do that I need to confirm that I am pulling the correct haircut number in correlation to a Trade ID which was already populated into the template in a previous line of code.
Using similar logic that I have been using throughout my entire project this is a snippet of code I have to perform this task.
Dim anvil as Worksheet
Dim ALLCs as worksheet
Dim DS as worksheet
'''''''''''''''''''''''''''''code above this line is irrelevant to answer this question
ElseIf InStr(1, DS.Cells(x, 2), "Haircut") Then
Anvil.Select
For y = 1 To 80
If Anvil.Cells(1, y) = "Haircut" Then
For Z = 1 To 80
If Anvil.Cells(1, Z) = "Trade ID" Then
For t = 2 To 70000
For u = 16 To 70000
If Anvil.Cells(t, Z) = ALLCs.Cells(u, 34) Then
ALLCs.Cells(u, 27) = Anvil.Cells(t, y)
End If
Next
Next
End If
Next
End If
Next
This code coupled with my other code I assume will in theory work, but I can only imagine that it will take an unbelievable amount of time(this program already takes 7 and a half minutes to run). Any suggestions on how to rewrite this code with better functionality, following this general logic?
Any help is appreciated, whether you completely revamp the code, or if you offer suggestions on how to cut down loops. I am also looking for suggestions to speed up the code in general aside from screen updating and calculation suggestions.
If I understand the logic correctly then you can replace all but one of the loops with a .Find() method like so:
'// Dimension range objects for use
Dim hdHaricut As Excel.Range
Dim hdTradeID As Excel.Range
Dim foundRng As Excel.Range
With Anvil
With .Range("A1:A80") '// Range containing headers
'// Find the cell within the above range that contains a certain string, if it exists set the Range variable to be that cell.
Set hdHaircut = .Find(What:="Haircut", LookAt:=xlWhole)
Set hdTradeID = .Find(What:="Trade ID", LookAt:=xlWhole)
End With
'// Only if BOTH of the above range objects were found, will the following block be executed.
If Not hdHaricut Is Nothing And Not hdTradeID Is Nothing Then
For t = 2 To 70000
'// Using the .Column property of the hdTradeID range, we can see if the value of Cells(t, hdTradeColumn) exists
'// in the other sheet by using another .Find() method.
Set foundRng = ALLCs.Range(ALLCs.Cells(16, 34), ALLCs.Cells(70000, 34)).Find(What:=.Cells(t, hdTradeID.Column).Value, LookAt:=xlWhole)
'// If it exists, then pass that value to another cell on the same row
If Not foundRng Is Nothing Then ALLCs.Cells(foundRng.Row, 27).Value = .Cells(t, hdHaircut.Column).Value
'// Clear the foundRng variable from memory to ensure it isn't mistaken for a match in the next iteration.
Set foundRng = Nothing
Next
End If
End With