Posts by Walthobum

I suppose the question is what sort of object do charts become when they are grouped? Are they shapes? Do I need to amend code to look for shapes and copy and paste them into Powerpoint instead of charts?

I have a workbook that creates a number of charts which I update every month. It would be very useful if I were able to copy and paste these charts into slides. However the way the charts work means I would need to see three charts grouped together on each slide, rather a single chart on a single slide. I'm never much good at explaining these things so hopefully the below might explain it better:

In the Excel Sheet I have

Chart1, Chart2 and Chart3, next to each other.
Chart4, Chart5 and Chart6, again next to each other.
Chart7, Chart8 and Chart9, also next to each other, and so on.

On the Excel sheet they make sense next to each other. One is actual performance against last year, one is a long term trend line, the final one if a plan against actual in year. In the Excel sheet I have set up the sheet so these charts sit next to each other and can be viewed easily. In the Powerpoint presentation I need to see them in the same way and the only way I can think to do that is to group them as below:

Chart1 + Chart2 + Chart3 grouped = Object1
Chart4 + Chart5 + Chart6 grouped = Object2
Chart7 + Chart8 + Chart9 grouped = Object3

How can I write some code that copies the objects, (I will group them in Excel if necessary), and pastes them into a single slide on Powerpoint for each object - i.e. - Slide1 contains Object1, Slide 2 contains Object2, Slide3 contains Object3 etc..

Many thanks.

Re: VBA works on step through, but not when I run

OK, apologies to anyone interested. The save issue was because one of the fName strings had a "/" character in it meaning it wouldn't save.

Re: VBA works on step through, but not when I run

An update on this. I have taken it off the network at work and run it on a standalone laptop. It works for a about 4 or 5 loops, (there are 91), and then crashes at the point where I am trying to save the workbook. Despite it having previously saved 4 or 5 other workbooks in the loop.

Could this be some kind of a storage issue or permissions? I'm baffled. Why would it work in 4 or 5 cases, then crash? I'm going to have to do this manually now which is going to be very annoying.

Re: VBA works on step through, but not when I run

Quote from NoSparks;799592

How do you initiate a test run ?
What happens if you put STOP as the first line of code in the sub ?

I am pressing Run in the script window. No buttons or whatever. Not heard about putting STOP as the first line of code before. I'll try it. For info though, how do you think that might help?

Re: VBA works on step through, but not when I run

Thanks for your help. Unfortunately that doesn't execute either. This is highlighted when I try to run it.

SvPath = .SelectedItems.Item(1) & Application.PathSeparator Else Exit Sub

Re: VBA works on step through, but not when I run

For clarity the code doesn't like this line:

SvPath = CurDir & "\"

Or this line:

Mth = InputBox("Enter the current reporting month", "Reporting month entry")

Both of these lines run when I step through although I haven't got to the point of actually saving a workbook in a step through. Therefore I'm focusing on this line:

ActiveWorkbook.SaveAs SvPath & fName & " - M" & Mth & " .xlsx", _
    FileFormat:=51, CreateBackup:=False

As being the culprit. Any help?

OK, so I'm testing some code. It works to a point on step through. It's a loop with a lot of data so I can't step through it all. However when I want to carry out a test run the code doesn't execute. I can't see why. Any help greatly appreciated. Here is the code.

Sub SplitDataToUniqueWorkBook()
Dim rCl As Range, rRng As Range
Dim fName As String, SvPath As String
Dim Mth As Integer
Dim LR As Long
Dim wsData As Worksheet
Dim rngData As Range


MsgBox "Please select a folder to save the completed files"
Application.FileDialog(msoFileDialogFolderPicker).Show
SvPath = CurDir & "\"
Mth = InputBox("Enter the current reporting month", "Reporting month entry")
With Sheets("Data")
    .Range("AJ1").EntireColumn.Delete
    .Range("A4").CurrentRegion.Columns(25).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet4.Range( _
       "AJ4"), Unique:=True
       
Set rRng = .Range(.Cells(5, 36), .Cells(.Rows.Count, 36).End(xlUp))
End With
For Each rCl In rRng
fName = rCl.Value
Sheets("Referrals").Range("A4").CurrentRegion.Clear
With Sheets("Data")
.Range("AH5").Value = rCl.Value
.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=.Range("AH4:AH5"), CopyToRange:=Sheets("Referrals").Range("A4"), Unique:=False
End With
ThisWorkbook.Sheets(Array("Source of Referral", "GP Referrals", "Referrals")).Copy


ActiveWorkbook.SaveAs SvPath & fName & " - M" & Mth & " .xlsx", _
    FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close True
Next rCl
End Sub

Re: VBA Advanced filter

Apologies again. The sub routine crashes on this line.

.Range("A6").CurrentRegion.Columns(9).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet4.Range( _ 
    "EB6"), Unique:=[COLOR=blue]True[/COLOR]

Re: VBA Advanced filter

Hopefully I won't have to start another thread as it's more or less the same issue, advanced filters.

This line of code is bugging out now and, again, it has always worked perfectly in the past. Any thoughts? I've checked the variables are declared and defined correctly.

With Sheets("Data")
    .Range("DZ2").Value = rCl.Value
    .Range("A6").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                    CriteriaRange:=.Range("DZ1:DZ2"), CopyToRange:=Sheets("Activity Data").Range("A6"), Unique:=False

Re: VBA Advanced filter

OK, so I have got past this issue now. I think it was due to the way I had set up my "Data" sheet in Excel - i.e. the "calculation" numbers in the row above my header row was causing an issue.

Thanks for your help.

Re: VBA Advanced filter

Quote from sktneer;794417

Should work fine.
Remember code is writing the data on Sheet4 (code name) starting from EB6. Is that correct?
Also shouldn't

Code

.Range("EB1").EntireColumn.Delete

be this

Code

Sheet4.Range("EB1").EntireColumn.Delete

As I assume you are deleting the column EB before writing new values in there. Right?
If that is the case, Sheet4.Columns("EB").Clear would be enough to achieve that.

Display More

Yes, that is the sheet I want the unique entries to be pasted to. Although the issue is that no entries are being pasted anywhere by the look of it. Also the second point you raise hasn't been a problem when I have used this technique in the past, but if I get nowhere with the checks I detailed in the post above, I'll give that a try.

Thanks for your thoughts.

Re: VBA Advanced filter

Quote from rory;794413

Hard to be sure without the workbook. Is Sheet4 the codename for the Data sheet?

Apologies. Sheet4 is the codename for the "Data" sheet. I'm just going to check a few things now to make sure it's not something really daft. Checking that I have unique header names. Also in the row above the headers I have numbers that I use for calculations. Could that be causing a problem somewhere? I might change the excel "Data" sheet to leave a row between these "calculation" numbers an the row with the headers in.

I'm trying to create a unique list from a column in a dataset. The following piece of code has run successfully, (with alterations where necessary for changes in the range, column required etc.), but now doesn't return any entries at range EB6. There definitely is data in the column 9 that I think should be returned. Can anyone see where I'm going wrong?

With Sheets("Data")
    .Range("EB1").EntireColumn.Delete
    .Range("A6").CurrentRegion.Columns(9).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet4.Range( _
       "EB6"), Unique:=True
       
Set rRng = .Range(.Cells(2, 132), .Cells(.Rows.Count, 132).End(xlUp))
End With

Many thanks,
K

So I have a .csv file that I am using to import calendar items into Ms Outlook. For whatever reason I tend to use this as a means to block out time for tasks but also to remind myself of tasks that need to be done and their priority etc.. Basically I update a list of calendar items during the day, every day and upload the calendar last thing before I clear off. I find this useful because, well, I'm like that.

Anyway it's got to the stage now where I pretty much rely on this technique and I find myself more and more wanting to incorporate more information into the upload. For example in the Description field I'll often write some notes from meetings, to remind myself of things I need to discuss when those meetings come around. Again, I find this useful as an aide memoire. I'm now desperately trying to find a way to get links to files, Excel, Word or Powerpoint files generally. Is there a way to do this or to embed the files into the .csv upload files?

Many thanks.

Re: Update pivot cache with range variable

OK, thought I might update this to reflect the solution I've been using in case anyone else wanted to know in the future.

Basically I've converted the data range for my pivotcache to a table and, well, it automatically updates the pivotcache for any additional rows as far as I can see. I haven't encountered any problems with it so far anyway.

Hi all,

I'm trying to update all pivot table with a macro. It has worked in the past for me really well but involved some manual intervention - i.e. choosing the initial range/pivot cache, then updating all other pivot tables using that range/pivot cache. What I'm trying to do now is take that part away from the end user by using a variable that is determined in other parts of the code. Can anyone spot what I'm doing wrong with this piece of code:

Obviously this only forms part of the overall code. pt declared as PivotTable and wks as a Worksheet.

Set ptcache = Sheets("Data").Range("A1").CurrentRegion




For Each wks In ActiveWorkbook.Worksheets
    For Each pt In wks.PivotTables
        pt.CacheIndex = ptcache
    Next pt
Next wks

Re: Copy and Paste Dynamic Range to First Unused Row of different Workbook

Hi, I have found a means to do what I want to do but it only works when I step through the code, not when I run the code in full. I have no idea why. The new code I have is below:

Sub CleanUpBusObjInvoiceReport()




Dim LastRow As Integer
Dim DebtWeek As Integer
Dim DebtYear As String
Dim Invoices As Range
Dim NextRow As Integer












DebtWeek = InputBox("Enter the weekly debt period", "Debt period entry")
DebtYear = InputBox("Enter the financial year", "Financial year entry")




With Sheets("CCG Invoices")
    .Range("A4").CurrentRegion.ClearFormats
    .Range("A4").CurrentRegion.ClearContents
End With




With Sheets("Bus Obj Data")
Columns("N:N").Select
Selection.Replace What:="Fully Settled", Replacement:="Exclude", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False




Columns("N:N").Select
Selection.Replace What:="Outstanding", Replacement:="Outstanding", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False




Columns("N:N").Select
Selection.Replace What:="Part Settled", Replacement:="Outstanding", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With




With Sheets("Bus Obj Data")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("O2:O" & LastRow).Formula = _
            "=RIGHT(B2,3)&N2"
End With




With Sheets("Bus Obj Data")
    .Range("O1").Value = "Check CCG"
    .Range("Z1").Value = "Check CCG"
    .Range("Z2").Value = "CCGOutstanding"
    .Range("O1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=.Range("Z1:Z2"), CopyToRange:=Sheets("CCG Invoices").Range("A4"), Unique:=False
End With




With Sheets("Bus Obj Data")
    .Range("A1").CurrentRegion.ClearFormats
    .Range("A1").CurrentRegion.ClearContents
End With




With Sheets("CCG Invoices")
    .Columns("O").EntireColumn.Delete
    .Range("A4").CurrentRegion.Font.Name = "Calibri"
    .Range("A4").CurrentRegion.Font.Size = 8
End With




With Sheets("CCG Invoices")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("O5:O" & LastRow).Value = DebtWeek
        .Range("O4").Value = "Debt Week"
        .Range("P5:P" & LastRow).Value = DebtYear
        .Range("P4").Value = "Debt Year"
        .Range("A4:P4").EntireRow.Delete
End With




Set Invoices = Worksheets("CCG Invoices").Range("A5").CurrentRegion
Invoices.Copy




Worksheets("Data2").Activate
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste




'Worksheets("CCG Invoices").Range("A5").CurrentRegion.Copy Destination:=Worksheets("Data2").UsedRange.Columns(1).Offset(1, 0)




End Sub

When I step through it executes exactly as I expect it to. However when I run the macro it seems only to execute to the line of code below, and no further:

.Range("P4").Value = "Debt Year"

I am genuinely baffled. Any help? Why would it run differently in different execution forms?

Hi all,

I am importing some data into a workbook. I want VBA to clean the data and copy and paste the 'cleaned' data to the bottom of a range in the same book on a different worksheet. I'm struggling to get my head around UsedRange and how I can use that to copy and paste to the right places in the book. For some reason that i cannot fathom the last line of code seems to be being skipped - i.e. it's not running. Oddly, when I step through using f8 it picks up this line of code. Not sure why that would be. Any help very much appreciated.

Code below:

Option Explicit




Sub CleanUpBusObjInvoiceReport()




Dim LastRow As Integer
Dim DebtWeek As Integer
Dim DebtYear As String




DebtWeek = InputBox("Enter the weekly debt period", "Debt period entry")
DebtYear = InputBox("Enter the financial year", "Financial year entry")




With Sheets("CCG Invoices")
    .Range("A4").CurrentRegion.ClearFormats
    .Range("A4").CurrentRegion.ClearContents
End With




With Sheets("Bus Obj Data")
Columns("N:N").Select
Selection.Replace What:="Fully Settled", Replacement:="Exclude", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False




Columns("N:N").Select
Selection.Replace What:="Outstanding", Replacement:="Outstanding", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False




Columns("N:N").Select
Selection.Replace What:="Part Settled", Replacement:="Outstanding", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With




With Sheets("Bus Obj Data")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("O2:O" & LastRow).Formula = _
            "=RIGHT(B2,3)&N2"
End With




With Sheets("Bus Obj Data")
    .Range("O1").Value = "Check CCG"
    .Range("Z1").Value = "Check CCG"
    .Range("Z2").Value = "CCGOutstanding"
    .Range("O1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=.Range("Z1:Z2"), CopyToRange:=Sheets("CCG Invoices").Range("A4"), Unique:=False
End With




With Sheets("Bus Obj Data")
    .Range("A1").CurrentRegion.ClearFormats
    .Range("A1").CurrentRegion.ClearContents
End With




With Sheets("CCG Invoices")
    .Columns("O").EntireColumn.Delete
    .Range("A4").CurrentRegion.Font.Name = "Calibri"
    .Range("A4").CurrentRegion.Font.Size = 8
End With




With Sheets("CCG Invoices")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("O5:O" & LastRow).Value = DebtWeek
        .Range("O4").Value = "Debt Week"
        .Range("P5:P" & LastRow).Value = DebtYear
        .Range("P4").Value = "Debt Year"
End With




Worksheets("CCG Invoices").Activate




With Sheets("CCG Invoices")
    .Range("A4:P4").ClearFormats
    .Range("A4:P4").ClearContents
End With




Worksheets("CCG Invoices").Range("A5").CurrentRegion.Copy Destination:=Worksheets("Data2").UsedRange.Columns(1).Offset(1, 0)




End Sub

Re: Export all unique entries from MS Access to MS Excel and save as .xlsx files

So this is the code I'm working with. I have changed some of the fields and table names from the original code. Not all of them though as I couldn't figure out what one line was doing. Any help greatly appreciated:

Option Compare Database




Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String




Const strQName As String = "zExportQuery"




Set dbs = CurrentDb




strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName




strSQL = "SELECT DISTINCT COMMCODE_CONTRACTCODE FROM dbo_Report_Master_1516_M03_v003A;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)




If rstMgr.EOF = False And rstMgr.BOF = False Then
      rstMgr.MoveFirst
      Do While rstMgr.EOF = False




            strMgr = DLookup("ManagerNameField", "ManagersTable", _
                  "ManagerID = " & rstMgr!ManagerID.Value)




            strSQL = "SELECT * FROM dbo_Report_Master_1516_M03_v003A WHERE " & _
                  "COMMCODE_CONTRACTCODE = " & rstMgr!COMMCODE_CONTRACTCODE.Value & ";"
            Set qdf = dbs.QueryDefs(strTemp)
            qdf.Name = "q_" & strMgr
            strTemp = qdf.Name
            qdf.SQL = strSQL
            qdf.Close
            Set qdf = Nothing




            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "F:\Finance\Service Agreements\Kieran\VBA Test\Access Loop Technique Files" & strMgr & Format(Now(), _
                  "ddMMMyyyy_hhnn") & ".xls"
            rstMgr.MoveNext
      Loop
End If




rstMgr.Close
Set rstMgr = Nothing




dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing