Posts by MD7

Re: Resolve Addlabel auto size issue where some text hidden on zoom

Thanks, yes, but in this case, I'm heavily restricted in what I can/should post from my clients environment. I may try to construct a simple example of what is happening in an entirely sterile demo workbook.

Re: Resolve Addlabel auto size issue where some text hidden on zoom

Making some progress...

Turns out that it has something to do with the row-height - even though I'm making no reference to cells or cell-references.

My row height was set quite small (5) when I experienced the problem. I've tried running the tool again with a much bigger row-height (100) and the second line of text remains visible at all zoom levels.

So, not an issue with my code as such - just a stupid excel2007 artefact.

Increasing the row height is not a solution though - it's treating the symptom rather than the cause. I need small row-heights later on in the project to be able to accurately hide sections of the drawing area.

Now that we know what is causing the behaviour, anyone know how to make a multi-line text box/label visible at all zoom levels in cases where the row-height is small (I.e. Rows narrower than the multi-line text box/label)?

I've an excel2007 tool that plots autoshapes and uses the Addlabel method to add a text box to each one.

The text is invariably split across two lines with a chr(10) new line.

The textframes have Autosize=true set and this (kinda) works.

What happens is that the second line of text is only visible at worksheet zoom levels of around 80% and greater magnification. Below this, only the text before the chr(10) line break is visible.

What's really annoying me is that if you right click on a label shape and follow the Format shape dialogue to the Textbox->autofit section, the checkbox is ticked. If you now cycle this checkbox off and back on, the size of the box does not change, but the second line of text now becomes visible at all zoom levels.

I've gone so far as to write a teeny routine to cycle through all my labels at the end of processing to flip Autosize off and back on again, but this doesn't work - there seems to be no substitute for manually flicking the Autofit checkbox.

Final part of the conundrum - my tool exports the finished shapes up PowerPoint as an Enhanced Metafile picture. The pasted picture has no issues - I.e. The second lines of text are always visible even if Excel was refusing to show them at the zoom level I copied them from...

Re: Data Validation Drop Down Not Showing

>So if you're validation lists magically stopped working, check to make sure you aren't deleting the drop down button by accident.

I so wish I'd found your reply an hour ago!

This is exactly what I was doing 'wrong'. I was programmatically deleting all shapes on a certain sheet with the exception of a command-button. As part of this, the drop-down validation arrows disappeared - but would magically reappear if the workbook was saved.

I have amended my code to ignore both the command button and drop-down shapes - and it works a treat. I suspect many people who have the 'missing drop-down' button issue have also somehow managed to empty the Shapes collection on a specific worksheet...

Re: SpellNumber() in Bold

...
               With acell.Characters(Start:=3, Length:=4).Font
                    .Bold = True
                    .Size = 14
                    .Subscript = True
                End With
...

This is a snippet of a bit of code I used a while back to format *part* of a text string. Being as you seem to have a fairly structured string (i.e. you can find the start and end positions of the text you want in bold fairly easily), it would seem to be a reasonable way to approach the problem.

FWIW, acell is defined as a Range (For each acell in Range("A1:B5")).

Re: Comparing 2 Columns + Copy Value

Aw! Where's the fun in that? ;o)

Re: Comparing 2 Columns + Copy Value

My solution attached:

Option Explicit






Sub CopyDetail()
    'written my MD7 for OZgrid.com
    'www.Alcester-Racing-Sevens.com
    
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim rngIDDetail As Range
    Dim rngIDToSearch As Range
    Dim aCell As Range
    Dim aFoundCell As Range
    
    Set wsDest = ThisWorkbook.Worksheets("Sheet1")
    Set wsSource = ThisWorkbook.Worksheets("Sheet2")


    Set rngIDDetail = mdFindSelectColasRange(wsSource, "ID Number", True)
    Set rngIDToSearch = mdFindSelectColasRange(wsDest, "ID Number", True)
    
    rngIDToSearch.Select
    
    For Each aCell In Selection
        Set aFoundCell = Find_Range(aCell.Value, rngIDDetail, , xlWhole)
    
        If aFoundCell Is Nothing Then
            'do nothing, no match found
        Else
            aCell.Offset(0, 6).Value = aFoundCell.Offset(0, 4).Value
            aCell.Offset(0, 7).Value = aFoundCell.Offset(0, 5).Value
        End If
    
    
    Next aCell






CleanyUppySection:


    Set wsSource = Nothing
    Set wsDest = Nothing
    Set rngIDDetail = Nothing
    Set rngIDToSearch = Nothing
    Set aCell = Nothing
    Set aFoundCell = Nothing






End Sub














Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Variant) As Range
     
    Dim c As Range, FirstAddress As String
     
    If IsMissing(LookIn) Then
    LookIn = xlValues 'xlFormulas
        End If
    If IsMissing(LookAt) Then
        LookAt = xlPart 'xlWhole
        End If
    If IsMissing(MatchCase) Then
        MatchCase = False
        End If
    
     
    With Search_Range
        Set c = .Find( _
            What:=Find_Item, _
            LookIn:=LookIn, _
            LookAt:=LookAt, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=MatchCase, _
            SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            FirstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
     
    Set c = Nothing
End Function












Function mdFindSelectColasRange(ws As Worksheet, strColName As String, boolResize As Boolean) As Range
    Dim rngCol As Range
    Dim introws As Integer
    Dim rngNew As Range
    Dim rngTest As Range
    
    
    On Error GoTo error_handler
    ws.Activate
    


'   Assumes Row 1 contains headings
'   Searches along Row A for the specified heading, selects column


'
    ws.Range("1:1").Select
    Range("A1").Activate
    Set rngTest = Selection.Find(What:=strColName, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not rngTest Is Nothing Then
        rngTest.Activate
    
        Set rngCol = ActiveCell.EntireColumn
    
        introws = Range("A65536").End(xlUp).Row
        
        If boolResize Then
            Set rngNew = rngCol.Resize(introws - 1, 1)
            Set mdFindSelectColasRange = rngNew.Offset(1, 0)
            
        Else
            Set rngNew = rngCol.Resize(introws, 1)
            Set mdFindSelectColasRange = rngNew
        End If
    Else
        Set mdFindSelectColasRange = Nothing
    
    End If
    
cleanup_section:
    Set rngCol = Nothing
    Set rngNew = Nothing
    Set rngTest = Nothing
    Exit Function
    
error_handler:
    MsgBox "An error has occurrificated. Please adjustify your set."
    
End Function

Re: Data for Pivot Table

I tried creating a pivottable from your test data (in XL2003) and found no issues.

If it is a justification issue, why don't you select ColB and force the justification to whatever you feel is appropriate???

Easy-peasy to do in VBA - or via the Macro Recorder for that matter...

I use Getpivotdata quite extensively to build and present data tables as I want them, but I have run into a (presumably not uncommon) problem.

(How) Can I use wildcards or pattern matching on pivotfields and data?

Typically, I extract all of the specific data I'm interested in:

intClosed(intCounter) = .GetPivotData(.PivotFields(1), .PivotFields(1).Name, _
                        strPee, .PivotFields(2).Name, "Closed").Value
                        
            intFixed(intCounter) = .GetPivotData(.PivotFields(1), .PivotFields(1).Name, _
                        strPee, .PivotFields(2).Name, "Fixed").Value
                         
            intOpen(intCounter) = .GetPivotData(.PivotFields(1), .PivotFields(1).Name, _
                        strPee, .PivotFields(2).Name, "Open").Value

...and then want to hoover the rest up into one or more buckets.

I'd *like* something similar to:

intChangeReqs(intCounter) = .GetPivotData(.PivotFields(1), .PivotFields(1).Name, _
                        strPee, .PivotFields(2).Name, "CR*").Value

...to total up anything matching the string-pattern CR....

Can this be done easily? The only way I can think of doing it is to extract all of the pivot data items into an array (say), whittle these down using some pattern matching, and then loop through the processed array with Getpivotdata...

Sounds like a plan, but has someone thought of a better approach?

Re: Phantom recovered documents pane?

Nope. What would I be looking for?

<edited to say>It appears to be empty...

Excel 2003.

I've had an infrequent problem with Excel when running some of my VBA projects and I think I've finally tracked it down - I was wondering if there's a better fix out there though...

...every now and then, when running a chunk of code (it uses the ADO library - an early version (2.1?) for compatability reasons), I get an empty pane overlaid on the main Excel window which obscures the worksheet underneath. The pane has no buttons, title etc. and can't be closed. Right-clicking on it brings up the toolbar menu...

Once it has appeared, there is no way to get rid of it short of closing Excel down. The spreadsheets continue to work fine - it's just that you can't see the left most couple of columns...

I've finally been able to get this as a reproducible problem - I had a general PC crash and Excel recovered some docs as a result. The recovered docs pane is exactly the same width as the mystery pane I sometimes see...

...I told Excel to keep the recovered docs as I needed to check them later - and now I always get the mystery pane each time I start Excel and run my code...

'Obviously', I'd be best off dealing with the recovered docs - but is there any way of sorting this out properly - or killing the pane without having to restart Excel...?

Re: Amalgamation one or more lines based on criteria

OK, well I've attached one solution based on one interpretation - which is that you are only interested in the 35801 values.

I haven't done a huge amount of testing on it, but it seems to work.

HTH for now. Regds, MD7

Option Explicit


Sub Amalgamate35801()
    'written by MD7 for OZGrid
    'www.Alcester-Racing-Sevens.com
    
    Dim ws As Worksheet
    Dim longTotal As Long
    Dim boolFirstOccurrence As Boolean
    Dim rngTargetCell As Range
    Dim longMaxRows As Long
    Dim longCurrRow As Long
    Dim varColAVal As Variant
    


    
    
    
    
    'Assumes Sheet1 is the data sheet.
    'replace 'Sheet1' by "ClosTfr 21...." if you wish
    Set ws = ThisWorkbook.Worksheets("ClosTfr 21-9-05 1718")
    
    'select all data in column J. Assume no header row
    longMaxRows = ws.Range("J65536").End(xlUp).Row
    
    'initialise longTotal - not necessary, but clean...
    longTotal = 0
    boolFirstOccurrence = True
    
    
    For longCurrRow = 1 To longMaxRows
        If ws.Cells(longCurrRow, 10).Value = 35801 Then
            If boolFirstOccurrence Then
                'identify value in col A
                varColAVal = ws.Cells(longCurrRow, 1).Value
                boolFirstOccurrence = False
                'set the cell that will take the total
                Set rngTargetCell = ws.Cells(longCurrRow, 11)
                longTotal = longTotal + ws.Cells(longCurrRow, 11).Value
                
            Else
                'do nothing
            End If
            
            
            Do While ws.Cells(longCurrRow + 1, 1).Value = varColAVal
                longTotal = longTotal + ws.Cells(longCurrRow + 1, 11).Value
                ws.Cells(longCurrRow + 1, 1).EntireRow.Delete shift:=xlShiftUp
                longMaxRows = longMaxRows - 1
            Loop
            
            rngTargetCell.Value = longTotal
            longTotal = 0
            boolFirstOccurrence = True
            Set rngTargetCell = Nothing
            
    
        Else
        'do nothing
        End If
    
    
    Next longCurrRow
    
    


CleanyUppySection:
    Set ws = Nothing


    


End Sub

Re: Amalgamation one or more lines based on criteria

Yes - fairly easy to achieve.

Is '35801' the only case where you want to amalgamate the lines, or do you want to do it for any line where there are more than one repeated entry in that column...?

<edited to remove an irrelevance relating to sorting...>

Re: Amalgamation one or more lines based on criteria

adncmm1980,

Your requirements are a bit hard to understand - I've attached an example of what I *think* you are trying to achieve.

If you can confirm that the bottom set of data shows the result you expect, then perhaps we can move this forward.

Regds,
MD7

Re: Confused Counting With Multiple Conditions

Sounds like a job for a pivottable...

Example attached.

Re: SQL call with MS Query via ADO - return unique entries only

Solved.

SELECT DISTINCT Version.description
FROM Neighbourhood.dbo.Issue Issue, Neighbourhood.dbo.Product Product, Neighbourhood.dbo.Version Version
WHERE Product.product_id = Issue.product_id AND Version.version_id = Issue.version_id AND ((Product.description In ('Sirius for Broking','Sirius for Insurance')) AND (Version.description Like '1._._'))

The DISTINCT keyword solves my problem. Yay!

Re: Prevent listbox horizontal scrollbar

Yay!

Thanks - that worked.

I 've been quite happily hoovering data into Excel from a SQL database for a while now. I use the MS Query wizard (in Excel) to construct a SQL query that I then use with with ADO.

My current project requires me to pop-up a userform to allow the user to restrict the search criteria - the database currently contains something like 10,000 records with multiple data fields.

I want to find a method to efficiently create the list of unique items from one of the field entries.

FWIW, the field I want to build the list from contains data of the form 1.X.Y (single digits with a '.' seperator - it's the version number of software under test).

At the moment, I am generating one call to the database to return this field when it is 'like 1._._', processing this in Excel to find the unique values, populating the listbox and then allowing the user to query the db once again to return all of the data associated with the relevant records.

This works - but the initial database call and processing is inefficient with 10k records - given that there are perhaps a dozen unique 1.X.Y version numbers in total.

Is there a way of getting SQL to give me the list of unique entries (i.e. the dozen in this case) and cut down on the amount of data transferred in the query???

FWIW, the first SQL query is:

SELECT Issue.issue_id, Product.description, Version.description
FROM Neighbourhood.dbo.Issue Issue, Neighbourhood.dbo.Product Product, Neighbourhood.dbo.Version Version
WHERE Product.product_id = Issue.product_id AND Version.version_id = Issue.version_id AND ((Product.description In ('SW Prod 1','SW Prod 2')) AND (Version.description Like '1._._'))

I have searched (briefly) in vain...

I must be missing something simple - I'm playing around with listboxes for the first time and I can't work out how to prevent a horizontal scrollbar appearing in the event that Excel decides the text is too wide...

The data I am populating my test listbox with is only a few characters long, but Excel seems to demand that the listbox be approximately 2.5 times the width of the text before it will stop forcing a scrollbar on me.

Any ideas?

Re: if statement based on font colour

Aha! Thanks Aaron.