MS Excel / VBA help thread

Then just point the existing pivot tables at the new data source; if the existing field names are the same in both data sources they will just refresh with the new data and you can add the new fields to the pivot as required

If you are using an earlier file as a template, insert however many new columns you need into the old data range paste the new data over it, rather than adding them as extra columns to the right. If you do it this way, the data source range will automatically adjust and the new fields wil appear when you refresh the pivots

Am wondering how to print comments (shift & f2 on cells) i've added to an excel 2007 pivot table and set to "show all comments".

They don't show in print preview, and "page setup > sheet" has a comments dropdown that is greyed out so can't be used.

Can anyone help advise? Google isn't much help when search terms include the word "comments".

Is the sheet/workbook protected?

Also, I seem to remember there's something funky about how you get to the page setup option. I think you need to go directly to it rather than print preview--> page setup. I had a similar trouble with paper sizes.

No protection, will try other route to Page Setup in the morning, ta.

Page Layout > Page Setup allowed the dropdown for comments printing, cheers.

I'm looking for a macro that looks through a folder and for each excel workbook in the folder lists the workbook, worksheets and the bottom used cell for each sheet.

I can probably put something together but I'd think there would be a macro already out there somewhere which does such a thing. I'm struggling with what to search for though and generally getting solutions with file sizes. Any suggestions for such a macro that you're aware of.
Cheers

Looks like a good page on it here: http://www.cpearson.com/Excel/foldertree.aspx

lists the... worksheets and the bottom used cell for each sheet

In order to do this you would need extra code to open, extract data and close each, which could be a long process.

Won't take more than a few minutes to change (bastardise) something I did before...Give me a few mins...

(Paste this in a module. Change strSearchLoc for directory location andbooIncludeSubDirs to indicate if to search subdirs, and run test(). All kinds of quick and dirty...)

Option Explicit
Dim FileList() As String

Sub test()
Dim strSearchLoc As String, booIncludeSubDirs As Boolean
Dim fCount, DumpRange
Dim sh As Worksheet, cl As Range, strSheetString As String
Dim wbkOG As Workbook, wbkImport As Workbook

Dim booWasHidden As Boolean, intLastColumn As Long, intLastRow As Long, intLastNonBlankColumn As Long, intLastNonBlankRow As Long, shThisRun As Worksheet, intNextRow As Long

strSearchLoc = "C:\"

booIncludeSubDirs = False

Set wbkOG = ActiveWorkbook

Sheets.Add
Set shThisRun = ActiveSheet
Cells(1, 1) = "No"
Cells(1, 2).End(xlToLeft).Offset(0, 1) = "Dir"
Cells(1, 3) = "FNE"
Cells(1, 4) = "FileDateTime"
Cells(1, 5) = "FileSize"
Cells(1, 6) = "Sheet Name"
Cells(1, 7) = "Hidden?"
Cells(1, 8) = "Last Row in Memory"
Cells(1, 9) = "Last Column in Memory"
Cells(1, 10) = "Last NonBlank Row"
Cells(1, 11) = "Last NonBlank Column"
intNextRow = 1

BuildFileListArray strSearchLoc, "*.xl*", booIncludeSubDirs

For fCount = 1 To UBound(FileList)
    Workbooks.Open FileList(fCount), False, True
    Set wbkImport = ActiveWorkbook
    Application.DisplayAlerts = True
    For Each sh In Worksheets
        booWasHidden = False
        If sh.Visible = xlSheetHidden Then
            sh.Visible = xlSheetVisible
            booWasHidden = True
        End If
        intNextRow = intNextRow + 1
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 1) = intNextRow - 1
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 2) = WorksheetFunction.Substitute(FileList(fCount), Dir(FileList(fCount)), "")
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 3) = Dir(FileList(fCount))
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 4) = FileDateTime(FileList(fCount))
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 5) = FileLen(FileList(fCount))
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 6) = sh.Name
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 7) = booWasHidden
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 8) = sh.Cells.SpecialCells(xlCellTypeLastCell).Row
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 9) = sh.Cells.SpecialCells(xlCellTypeLastCell).Column
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 10) = GetLastRow(sh.Name)
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 11) = GetLastColumn(sh.Name)
    Next sh
    Workbooks(Dir(FileList(fCount))).Close (False)
Next fCount

End Sub
Public Function StripToAlphaC(strString As String) As String
Dim n As Integer, booRemove As Boolean

n = 0
StripToAlphaC = strString
For n = 1 To Len(StripToAlphaC)
    booRemove = True
    If Asc(Mid(StripToAlphaC, n, 1)) >= 48 And Asc(Mid(StripToAlphaC, n, 1)) <= 57 Then booRemove = False
    If Asc(Mid(StripToAlphaC, n, 1)) >= 65 And Asc(Mid(StripToAlphaC, n, 1)) <= 90 Then booRemove = False
    If Asc(Mid(StripToAlphaC, n, 1)) >= 97 And Asc(Mid(StripToAlphaC, n, 1)) <= 122 Then booRemove = False
    If Asc(Mid(StripToAlphaC, n, 1)) = 32 Then booRemove = False
    If booRemove Then
        StripToAlphaC = Left(StripToAlphaC, n - 1) & Right(StripToAlphaC, Len(StripToAlphaC) - n)
        n = n - 1

    End If
    If n >= Len(StripToAlphaC) Then Exit For

Next n
StripToAlphaC = StrConv(StripToAlphaC, vbProperCase)

End Function

Public Sub BuildFileListArray(PathToSearch As String, TextFilter As String, IncSubs As Boolean)
Dim sFName As String, fso As Object, strName As String, strArr(1 To 65536, 1 To 1) As String, I As Long, n As Integer

If IncSubs Then
    strName = Dir$(PathToSearch & "\*" & TextFilter & "*", 15)
    Do While strName <> vbNullString
        I = I + 1
        strArr(I, 1) = PathToSearch & "\" & strName
        strName = Dir$()
    Loop
    Set fso = CreateObject("Scripting.FileSystemObject")
    Call recurseSubFolders(fso.GetFolder(PathToSearch), strArr(), I, TextFilter)
    Set fso = Nothing
    If I > 0 Then
        ReDim Preserve FileList(I)
        For n = 1 To I
            FileList(n) = strArr(n, 1)
        Next n
    End If
Else
    sFName = Dir$(PathToSearch & "\*" & TextFilter & "*", 15)
    Do While Len(sFName) > 0
        n = n + 1
        ReDim Preserve FileList(n)
        FileList(n) = PathToSearch & "\" & sFName
        sFName = Dir$()
    Loop
End If

End Sub
Private Sub recurseSubFolders(ByRef Folder As Object, ByRef strArr() As String, ByRef I As Long, ByRef searchTerm As String)
Dim SubFolder As Object, strName As String

For Each SubFolder In Folder.SubFolders
    Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*", 15)
    Do While strName <> vbNullString
        I = I + 1
        strArr(I, 1) = SubFolder.Path & "\" & strName
        strName = Dir$()
    Loop
    Call recurseSubFolders(SubFolder, strArr(), I, searchTerm)
Next

End Sub

Function GetLastRow(strSheetName) As Long
Dim x As Long

For x = 1 To Sheets(strSheetName).Cells.SpecialCells(xlCellTypeLastCell).Column
    If Sheets(strSheetName).Cells(1048576, x).End(xlUp).Row > GetLastRow Then GetLastRow = Sheets(strSheetName).Cells(1048576, x).End(xlUp).Row
    If GetLastRow = Sheets(strSheetName).Cells.SpecialCells(xlCellTypeLastCell).Row Then Exit Function
Next x

End Function
Function GetLastColumn(strSheetName) As Long
Dim x As Long

GetLastColumn = Sheets(strSheetName).Cells.SpecialCells(xlCellTypeLastCell).Column
Do
    If Sheets(strSheetName).Cells(1048576, GetLastColumn).End(xlUp).Row = 1 And Sheets(strSheetName).Cells(1, GetLastColumn) = "" Then
        GetLastColumn = GetLastColumn - 1
    Else
        Exit Do
    End If
Loop Until GetLastColumn <= 1

If GetLastColumn = 0 Then GetLastColumn = 1

End Function

(No idea what's happening with the code bit, select the whole post and paste in in the text editor)

Excellent, just what I needed. Thanks a lot.

Not quite sure what happened with the formatting, it seemed to add in some arbitrary hyphens when I pasted it in but once I removed those it worked perfectly.

I have a sheet with component id's as rows and component features as columns.

I would like a conditional format that returns a colour and a COMPLETE where there is a text entry in each component feature column.

So the line item under RAG shows as COMPLETE when the component has an entry for each cell in the row.

1 Attachment

This is really pissing me off, it seems so trivial and yet it's been annoying me all morning.

I have a macro that runs through a load of files and creates a pivot table in each. Files are identical in format.

Everything is fine except for one point.

The values that I am summing, the date fields, are appearing stacked as rows rather than as a column for each one.

Basically like this http://www.mrexcel.com/forum/excel-questions/476975-visual-basic-applications-pivot-table-datafields-horizontal-vertical.html

However, because I'm generating lots of pivot tables the code in the solution there doesn't work (it's not always pivot table 1). I've tried a whole variety of solutions and just get constant errors.

Grateful for any help if I'm missing something obvious

This is my code so far:

Sub testpivot()

Dim objTable As PivotTable, objField As PivotField

' Select the sheet and first cell of the table that contains the data.

' ActiveWorkbook.Sheets("Employees").Select

Range("A1").Select

' Create the PivotTable object based on the Employee data on Sheet1.
Set objTable = Sheet1.PivotTableWizard

' Specify row and column fields.
Set objField = objTable.PivotFields("Customer")
objField.Orientation = xlRowField
   objField.Position = 1
Set objField = objTable.PivotFields("Product")
objField.Orientation = xlRowField
   objField.Position = 2
Set objField = objTable.PivotFields("Prod Descr")
objField.Orientation = xlRowField
   objField.Position = 3
Set objField = objTable.PivotFields("Character")
objField.Orientation = xlRowField
   objField.Position = 4
Set objField = objTable.PivotFields("BillT")
objField.Orientation = xlRowField
   objField.Position = 5

' Format as tabular
 objTable.RowAxisLayout xlTabularRow

 With objTable

For Each objField In .PivotFields
' pvtFld.Subtotals(1) = True
objField.Subtotals(1) = False
Next objField
End With

With objTable
For Each objField In .DataPivotFields

objField.Orientation = xlcolumfield
Next objField
End With

' Specify a data field with its summary
' function and format.
Set objField = objTable.PivotFields("Sales UOM")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "#,##0"




Set objField = objTable.PivotFields("  Gross Sls")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "#,##0"

End Sub

Actually, this isn't part of the code, just an experiment that didn't work (I can't edit posts at work strangely)

With objTable
For Each objField In .DataPivotFields

objField.Orientation = xlcolumfield
Next objField
End With

No worries, I figured it in the end.

A silly question.
I have some data in one worksheet. I have defined the ranges of data using the named ranges in excel 2010.
This is great. It means I've defined things like "year" and "month". Because, I'm going to have to periodically dump data into this sheet.
I've then set up a calculation spread sheet off of this. So that I can calculate things like the number of times x happens in year 1, month 0, for a particular place. (i.e. countifs)

I have three sheets of data that will have data dumped into them. And each data sheet has a calculation sheet attached to it.

The problem is, my book has started to slow down a lot. Deleting and moving sheets around is not instantaneous. Is there a limit to how many ranges I can use? Am I, in essence, creating lots of pivot tables in one book?

What I want to do is dump data from each source into its respective sheet, have the calculation sheets calculate things. And then produce 1 summary table from each calculation sheet. With some graphs.

Because the ranges are dynamic, this should mean that i have to do very little but export data, import data, look at summary table and graphs. Shout when something looks wrong.

Does that even bro?

To be honest, I don't follow exactly what you're trying to do, however quantity of data is likely important.

I seen countifs (and sumifs) have a marked effect on spreadsheet calculation times over large (50K+) numbers of rows. I've also seen the increased row count (1m+) in excel 2010 effect memory / performance when it's referenced in formulae, even when when most of it is empty (perhaps your named ranges are very very large - do they span an entire column, then you're countif'ing over that?).

I'd start here, make sure your named ranges themselves aren't massive (perhaps google 'dynamic named range' to limit their size).

If you don't mind if it takes a few seconds to get your data, perhaps you could turn calculation to manual.

Feel free to ask more / pm

dynamic named range is limited to one column per named range.
i.e.
DateofReport = J:J

I'm guessing that's the limiter?

should be able to use the offset function to shorten your named ranges, tutorial here

http://www.excel-easy.com/examples/dynamic-named-range.html

I'll convert those ranges using offset.
Thanks!

Bro, do you XLSB ?

I find xlsb only speeds up opening (and shrinks the file) it doesn't actually speed up operations within it.

Another killer for calculation speed is vlookups.

If it's a long-term thing and the data is just going to get bigger it may be worth looking at PowerPivot. It's relatively simple to learn the basics and is a lot faster. Definitely more complicated though.

Index/Match > vlookup

I've never found much of a speed difference between the two