I created a macro in Excel for creating bar graphs automatically.
Whenever I run it, it gives "smr run time error" and I am not able to figure out what is wrong with my code.
Sub CreateGraph()
'
' CreateGraph Macro
''Initialize variables
Dim lastRow As Integer
Dim xlsPath As String
Dim xlsFile As String
xlsPath = "H:\"
xlsFile = "text.xls"
Workbooks.Open Filename:=xlsPath & xlsFile
ActiveWindow.SmallScroll Down:=-81
Range("A1:B" & lastRow).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'TEST'!$A$1:$B" & lastRow)
ActiveChart.ChartType = xlBarClustered
ActiveChart.Axes(xlCategory).Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.Axes(xlCategory).ReversePlotOrder = True
Range("Q111").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Can anyone help me in solving this puzzle please.
Also for running any macro automatically from SAS, I always have to change the Excel options for "enable all macros" which I suppose is not good. I have seen people creating and running macros without doing this. Can you please tell me how can I run the macros with enabling all macros option in Excel.
The code within this version of the answer is essentially unchanged from the previous version. However, the text has been rewritten to (1) describe my experience of this type of project, (2) answer the true question and (3) better explain the solution.
My experience of this type of project
I have been involved in five such projects. In each case, the client believed they required the automatic creation of charts but detailed discussion revealed that that this was not the requirement. The clients all published a substantial number of charts per month but most of the charts were the same as last month but with new data. They needed to automate the provision of new data for the charts. Every month some charts were revised but this was humans agreeing better ways of presenting the data. They wanted the 90% of charts that were unchanged to go through without any effort and implementation of the revisions to be as easy as possible.
In this case, the questioner publishes 100 charts per month in the form of an Excel workbook. The data for these charts comes from an Access database. The solution allows for the charts to be changed easily but this is to ease the programming and not to provide more than has been requested.
Release Template.xls
The solution requires a hand-crafted workbook named Release Template.xls. This workbook will contain all the charts and the Month 1 data. The solution creates a copy of this workbook named Release YYMM.xls in which the Month 1 data has been overwritten by the MM/YY data.
Release Template.xls contains a worksheet, Params, which will be deleted from the release version. This worksheet has a title row and one data row per chart. There are five columns: Sheet Name, Range, Number of Rows, Number of Columns and SQL command.
Sheet Name and Range define the location of the source data for the chart.
Number of Rows and Number of Columns define the size of the range. These values should be generated from the range (or vice versa) but this generation is not difficult and its inclusion would complicate the answer for little advantage.
SQL command is the command to be used to extract the data for the chart from the database. The code below assumes the SQL command generates a Recordset containing data ready to drop into the worksheet.
These parameters could be in the Access database but I believe they fit more logically in the workbook. These parameters control getting data out of the Access database and into the Excel workbook. If a chart is changed such that it requires new data, these parameters must be changed to match but no change is required to the code.
Envelope
When this code was tested, it was within an Access Module. It could probably be transferred to a form but that has not been tested. There MUST be a reference to the "Microsoft Excel 11.0 Object Library".
This envelope should be suitable for any similar problem.
Option Compare Database
Option Explicit
Sub Control()
' This list includes the variables for the envelope and the generation code
Dim DestFileName As String
Dim Path As String
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
' I have my Excel file and my Access database in the same folder.
' This statement gets me the name of the folder holding my database.
' You may need to define a different path.
Path = Application.CurrentProject.Path
' Create path and file name of "Resource YYMM.xls"
DestFileName = Path & "\" & "Resource " & Format(Date, "yymm") & ".xls"
' Create copy of "Resource Template.xls".
FileCopy Path & "\Resource Template.xls", DestFileName
Set xlApp = New Excel.Application
With xlApp
.Visible = True ' This slows the macro but helps with debugging
' .Visible = False
Set xlWB = .Workbooks.Open(DestFileName)
With xlWB
' Code to amend "Resource YYMM.xls" goes here
.Save ' Save the amended workbook
.Close ' Close the amended workbook
End With
Set xlWB = Nothing ' Clear reference to workbook
.Quit ' Quit Excel
End With Set xlApp = Nothing ' Clear reference to Excel
End Sub
Code to generate copy data to workbook
This code assumes it is possible to create SQL statments that will generate Recordsets of data ready to drop into the workbook.
This code has been partially tested. The tests parameters defined ranges in the workbook which matches the size of the parameters. The data loaded into Params() was written to these ranges.
Dim DestSheetName As String
Dim NumCols As Integer
Dim NumRows As Integer
Dim OutData() as Variant
Dim Params() as Variant
Dim RngDest As String
Dim RowParamCrnt As Integer
Dim RowParamMax As Integer
Dim SQLCommand As String
With .Sheets("Params")
' Find last used row in worksheet
RowParamMax = .Cells(Rows.Count,"A").End(xlUp).Row
' Read entire worksheet into array Params
Params = .Range(.Cells(1, 1), .Cells(RowParamMax, 5)).Value
xlApp.DisplayAlerts = False ' Surpress delete confirmation
.Delete ' Delete parameters sheet
xlApp.DisplayAlerts = True
End With
' Params is an array with two dimensions. Dimension 1 is the row.
' Dimension 2 is the column. Loading Params from the range is
' equivalent to:
' ReDim Params( 1 to RowParamMax, 1 to 5)
' Copy data from worksheet to array
For RowParamCrnt = 2 To RowParamMax
DestSheetName = Params(RowParamCrnt, 1)
DestRng = Params(RowParamCrnt, 2)
NumRows = Params(RowParamCrnt, 3)
NumCols = Params(RowParamCrnt, 4)
SQLCommand = Params(RowParamCrnt, 5)
' Use the SQL command to create a Recordset containing the data
' for the chart.
' Check the Recordset's dimensions against NumRows and NumCols
ReDim OutData(1 to NumRows, 1 to NumCols)
' Note (repeat Note): the first dimension is for rows and the
' second dimension is for columns. This is required for arrays
' to be read from or to a worksheet.
' Move the data out of the Recordset into array OutData.
.Sheets(DestSheetName).Range(DestRng).Value = OutData
Next
Related
I really need help. In my data base on excel and the first column is made up by the codes of my clients. Every client can have different number of rows and so on. What I’m trying to do is create a VBA Macro that can go through my list of client codes and for each code copy it’s rows on the DB to a new worksheet. And to do this for all the client codes I have like on loop, after copying the first one to go automatically to the next code.
Please help :(
I hope this provides a framework for you to do what you want.
Key concepts
Use autofilter to identify all records for each client
store client id in a dictionary to keep track of what has been processed
use SpecialCells to reference filtered rows
My simple input data
My output
Let me know if its helpful
Option Explicit
Sub master_db_to_individual()
Dim ws_in As Worksheet
Set ws_in = ThisWorkbook.Worksheets("master_db")
' Not knowing the actual shape of the data, this is just a simple way to set the required range locations
Dim r_keys As Range
Set r_keys = Range(ws_in.Range("a2"), ws_in.Range("a2").End(xlDown))
Dim r_all_data_with_headers As Range
Set r_all_data_with_headers = ws_in.Range("a2").CurrentRegion
'create a dictionary to store client codes found
Dim client_codes As Object
Set client_codes = CreateObject("Scripting.Dictionary")
' create a new workbook for individual data
Dim wb_individual As Workbook
Set wb_individual = Application.Workbooks.Add
Dim initial_ws_count As Long
initial_ws_count = wb_individual.Worksheets.Count
' loop all entires in the client code column of the master data
Dim client_code As Range
For Each client_code In r_keys
'test if have already processed the current row
' I am assuming here that the order of the client records can not be guaranteed
If Not client_codes.Exists(client_code.Value) Then
' make a record that this client has been processed so if we find another row for this client we know to skip
client_codes.Add client_code.Value, client_code.Value
'ensure a sheet for this client exists by inserting and supressing error if already exists
Dim ws_this_client As Worksheet
Set ws_this_client = wb_individual.Worksheets.Add(after:=wb_individual.Worksheets(wb_individual.Worksheets.Count))
ws_this_client.Name = client_code.Value
'filter all rows that have this client key so they can be copied
r_all_data_with_headers.AutoFilter field:=r_keys.Column, Criteria1:=client_code.Value, Operator:=xlFilterValues
'copy filtered data with headers to new sheet
r_all_data_with_headers.SpecialCells(xlCellTypeVisible).Copy ws_this_client.Range("a1")
End If
Next client_code
' remove autofilter
r_all_data_with_headers.AutoFilter
' remove unsed sheets in new workbook
Dim i As Integer
Application.DisplayAlerts = False
For i = initial_ws_count To 1 Step -1
wb_individual.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True
ws_in.Activate
ws_in.Range("a1").Select
Set client_codes = Nothing
End Sub
I'm still reasonably new to VBA and feel I'm punching a little above my weight, so hopefully someone can help.
I need to issue a spreadsheet to people in my company which they can fill out and send it back. This needs to be done multiple times, so I have tried to automate this as much as possible. The source data is pasted in an "input" tab - this is then pivoted by user and input into a template tab. I can select any user and run a macro which does this and exports the filled out template to a new workbook.
In this template tab, I have dependent drop-down lists, which I have done by data validation - this relies on named ranges from the "coding" tab, which is also exported. One named range shows a list of values, and the other indexes over this and matches it to the required cell, to ensure only valid combinations are shown.
My issue is that the new workbook must not contain any links to the master - it should function completely in its own right. However, something is going wrong with the data validation/named ranges. Either some named ranges are being deleted (I know which bit of code is doing that but without it you get prompted to update links) or the data validation formula links back to the original workbook and doesn't work. I cannot find another way of achieving what I need without this particular data validation set up, so I need to try and adjust my macro to cater for this.
Is it possible to simply copy the template and coding tabs, with all the data validation, to a new workbook and break all links to the original, so that there are no startup prompts and the drop-downs all work?
Sub Copy_To_New_Workbook()
Dim wb As Workbook
Dim name As String
Dim ExternalLinks As Variant
Dim x As Long
Dim strFolder As String, strTempfile As String
name = Worksheets("Control").Cells(14, 7).Value
Let FileNameIs = Range("Filepath").Value & Range("FileName").Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Coding").Copy Before:=wb.Sheets(1)
ActiveSheet.name = "Coding"
ThisWorkbook.Worksheets("Transactions").Copy Before:=Worksheets("Coding")
ActiveSheet.name = "Transactions"
With ActiveSheet.UsedRange
.Value = .Value
End With
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For x = 1 To UBound(ExternalLinks)
wb.BreakLink name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
Dim objDefinedName As Object
For Each objDefinedName In wb.Names
If InStr(objDefinedName.RefersTo, "[") > 0 Then
objDefinedName.Delete
End If
Next objDefinedName
On Error GoTo 0
wb.SaveAs Filename:=FileNameIs, FileFormat:=52
ActiveWorkbook.Close
End Sub
I am able to read another workbook and copy the contents, but when I try to paste into the existing Table - Excel hangs and freezes. If I copy the data into another sheet with no existing Table, then it works fine.
I am using this:
Dim sFound as String
Dim lRow as Long
Dim data_sheet As Worksheet
Dim wb as Workbook
Dim wb_data as Workbook
Set wb = ThisWorkbook
sFound = Dir(ActiveWorkbook.Path & "\data*.csv)
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & sFound
End If
Set wb_data = ActiveWorkbook
Set data_sheet = Sheets("raw data")
lRow=data_sheet.Cells(data_sheet.Rows.Count,2).End(xlUp).Row
data_sheet.Range("A10:V" & lRow).Copy
wb.Sheets("Data").Range("Data[Code]").PasteSpecial
Application.CutCopyMode = False
wb_data.Close
Any assistance in why the paste is causing the hang up in the table would be greatly appreciated.
2018-09-21 Update
I managed to fix the freezing and hanging through a combination of Marucciboy2's post and my own research. I stored the entire raw data set I was copying into a variant variable. Then, I resized the new table I was copying to to be the same length as the raw data. Then I just set that entire data range value the same as the variant variable. I will update this with the code.
I am still having one issue with is figuring out how to copy one particular column or certain range of columns of one table into another table. I can resize the new table just fine. I just don't know how to set one column into a variant variable or if I need to do something else. Then, I don't know how to set the new table column to that variant variable. Again, will have to post code tomorrow.
I have been trying to find a solution, be it a macro or a simple solution, to create and format charts in a powerpoint presentation. So far I could not find anything that would solve my issue.
The idea is to source data from a fairly big excel file and then create several charts on several powerpoint slides. That is, one big excel file and 10 powerpoint slides, with 8 individual charts on each slide.
I tried this: http://mahipalreddy.com/vba.htm#ppgraph, but that did not help at all.
How can I solve this?
This is the approach I would use:
Set up the charts initially in PPT using Insert Chart.
Then from VBA, for each chart collect the data from the Excel source
file and store the data in array variables.
Use these variables to update the chart's series data (alternatively update the powerpoint chart's embedded worksheet .ChartData).
There are other methods like using OLEObjects to link/embed, but frankly those are a pain to work with, and can pose problems if the file(s) are on a shared drive, if they're moved or renamed, etc.
Here is the general framework I describe above.
This will require a good amount of modification on your end -- for example this is configured only for 1 chart on 1 slide, and I have no idea how your data in Excel is arranged, so I just put in some dummy code to show how I would capture some values from Excel, you'll obviously need to fine tune that with a good amount of code so that it is dynamic enough to work on all charts (this can be done easily enough if your data is organized well, and you know your way around Excel VBA).
Option Explicit
Option Base 1
Sub GetChartDataFromXLS()
Dim wbFileName As String '## full filename & path of the Excel file.'
Dim oXL As Object
Dim xlWB As Object
Dim xlWS As Object
Dim cl As Object
Dim c As Long
Dim shp As Shape
Dim cht As Chart
Dim srs As Series
Dim x As Long
Dim sArray() As Variant '## temporary array for each series, will be stored in chtData array.'
Dim chtData() As Variant '## I would use this array to store several arrays from the Excel file.'
Dim s As Long
wbFileName = "C:\users\david_zemens\desktop\dummy chart data.xlsx"
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
Set xlWB = oXL.Workbooks.Open(wbFileName)
'## iterate over the shapes in the slide.'
For Each shp In ActivePresentation.Windows(1).Selection.SlideRange(1).Shapes
'## check to see if this shape is a chart.'
If shp.HasChart Then
'## set the chart variable.'
Set cht = shp.Chart
'## clear out any existing series data in the chart'
For s = cht.SeriesCollection.Count To 1 Step -1
Set srs = cht.SeriesCollection(s)
srs.Delete
Next
'##Your code to get the chtData will go in this block:'
'##
Set xlWS = xlWB.Sheets(1) ' ##Modify to get the correct sheet where the data for this chart resides'
'## It will probably be something like this, which '
' iterates over some columns and collects data in to a series'
' of arrays, stored within chtData array '
For x = 1 To 3 'However Many Series you need to add:'
'Assuming data series begins in column A, etc...'
c = 1
For Each cl In xlWS.Range("A1:A10").Offset(0, x - 1)
ReDim Preserve sArray(c)
sArray(c) = cl.Value
c = c + 1
Next
'ReDim Preserve the chtData array
ReDim Preserve chtData(x)
chtData(x) = sArray
Next x
'## End collection of the chart data.
'## Expose the data sheet but minimize it to preserve updating
cht.ChartData.Activate
cht.ChartData.Workbook.Application.WindowState = -4140
'## Now, take that data and insert it to the chart
If LBound(chtData) >= 1 Then
For s = LBound(chtData) To UBound(chtData)
'## Add a new series to the chart
Set srs = cht.SeriesCollection.NewSeries
srs.Values = chtData(s) '## Modify this line to point at the appropriate array from chtData'
'manipulate the other series properties here '
'srs.Name = "whatever the series name" '
'srs.XValues = "whatever the series value" '
'# etc...
'# etc...
Next 'Next series...
End If
'## Close the chartdata sheet.
cht.ChartData.Workbook.Close
End If
Next
oXL.ActiveWorkbook.Close
oXL.Quit
On Error Resume Next
Set oXL = Nothing
Set xlWB = Nothing
Set xlWS = Nothing
On Error GoTo 0
End Sub
This method does not write to the chart's data sheet. Frankly I see that as an unnecessary step if you are creating a macro-driven dashboard, there should not be any reason to need the data sheet, but if that is needed for some reason, we can modify the way the chart's series are created.
Another method would be to use a free charting plugin for PowerPoint called oomfo # http://oomfo.com
Using oomfo, you can build charts that are connected to live Excel sheets. Once you've built a chart connected to the Excel data source, whenever the Excel worksheet gets updated, and the presentation is viewed, the charts automatically pull in the latest data. You'll just need to ensure that PowerPoint should have access to that Excel file (either locally or remotely).
Link to documentation of Excel data source is at http://docs.oomfo.com/charts/1.0/contents/chart_data/data_excel.html
Here is what I am trying to do. I am trying to create a workbook based on a template named by the title and to create a workbook for each row. And for the macro to loop until all rows have been depleted.
The deliverables that I want at the end are 3 excel documents named (Alpha.xlsx, Beta.xlsx, Gamma.xlsx) with the corresponding values from access plugged into their corresponding cells in their corresponding workbook. The subsequent math is there because I need to be able to manipulate the values once they are in excel.
Here is some of the research that I've found that I haven't quite been able to make much sense of due to my lack of experience coding in vba.
Links
(I can't post more than 2 so I'll keep the number of articles terse):
Research: databasejournal.com/features/msaccess/article.php/3563671/Export-Data-To-Excel.htm
Example Database/Spreadsheet:
http://www.sendspace.com/file/iy62c0
Image Album (has a picture of the database and the template in case you don't want to download):
http://imgur.com/pytPK,PY8FP#0
Any help will be much appreciated! I've been reading up and trying to figure out how to get this to work #.#
This isn't complete, but should help you get started...
Option Compare Database
Option Explicit
'Enter Location of your Template Here
Const ExcelTemplate = "C:\MyTemplate.xltx"
'Enter the Folder Directory to save results to
Const SaveResutsFldr = "C:\Results\"
Sub CreateWorkbook()
Dim SaveAsStr As String
Dim ExcelApp, WB As Object
'Create Reference to Run Excel
Set ExcelApp = CreateObject("Excel.Application")
'Create Reference to your Table
Dim T As Recordset
Set T = CurrentDb.OpenRecordset("tblData")
'Loop through all Record on Table
While Not T.BOF And T.EOF
'Open Your Excel Template
Set WB = ExcelApp.Workbooks.Open(ExcelTemplate)
'Enter your data from your table here to the required cells
WB.Worksheets("NameOfYourWorkSheet").Range("A1") = T("numValue1")
'Repeat this line for each piece of data you need entered
'Changing the Sheet name, cell range, a field name as per your requirements
'WB.Wor...
'WB.Wor...
'Save and Close the Workbook
SaveAsStr = SaveResutsFldr & T("Title") & ".xlsx"
WB.SaveAs SaveAsStr
WB.Close
Set WB = Nothing
'Move to the Next Record
T.MoveNext
Wend
'Close down the Excel Application
ExcelApp.Quit
Set ExcelApp = Nothing
End Sub