Posts by Rob Xaos

Re: Search form not working

notla,

Please do not add SOLVED to thread titles. This makes it more difficult to search for Solver related threads. Thank you

Re: Create a new sheet if the database contains certain number / text

Change:

With ThisWorkbook

to

With ActiveWorkbook

And you need to ensure that the workbook you are processing has a Worksheet called "Database" or you need to modify the code.

Re: Password Protecting Individual Sheets

All the points you ask are in the threads listed below in Possible Answers, as I mentioned above. With regard to changing protected Worksheets look at: http://www.ozgrid.com/VBA/excel-macro-protected-sheet.htm and you can also search for UserInterfaceOnly.

I will state what is also mentioned in most of the threads on this kind of subject: Ultimately, Excel is not a secure environment. Protection in Excel relies on the User enabling Macros (which is always voluntary). Also, Excel passwords can be bypassed within minutes by readily available Add-ins. You can restrict access to those who are not knowledgable but anyone with even fairly limited VBA experience can, if they wish, always get access.

Re: Can Excel handle repeatedly creating and destroying controls

Going to add a couple of points as observation on all of the above:

1) I understand you consider all the Controls and Worksheets necessary and certainly they are what you have become used to, but I would concur with Dave's somewhat direct comment and say that it is far too many sheets and controls for Excel or Windows to remain stable. The approach of creating and destroying controls may buy you some breathing space but is more likely to just test Excel's garbage memory collection to the limit.

2) If you follow Cytop's advice, be sure to back-up the registry before making any changes. While the change he proposes should not have any adverse effect, changing the Registry always carries some risk, if only from human error. Broken registry = Hours of grief. However again, if this does work for you, it is probably only buying you time.

3) I think you really need to reconsider how you are carrying out the larger task. Not the process of opening and closing Workbooks and Worksheets in Excel or editing the data on them, but the task that that process achieves. To have that many worksheets and require that number of controls to me suggests a task that needs to be approached from a new direction.

Re: Client Server Based Macro

If you read through the link I provided you will see some code by Dave Hawley to create a menu item for your macro. If you modify that so that it creates a menu with an item per macro then you simply have to change the .OnAction = "MyGreatMacro" part for each menu item where "MyGreatMacro" is replaced each time by the name of the macro you wish to call. That will give you a menu to allow your users to select the macro from a menu. There are other ways as well but this should get you started.

Re: Finding next empty row

There are a couple of ways to do this, one is fast but some arrangements of blank cells and columns will return a false result:

Sheet1.Range("A1").CurrentRegion.Rows.Count

The only sure-fire way, to my knowledge, is to iterate through the columns:

Dim lngMaxNR As Long, lngCol As Long
    For lngCol = 1 To 26
        nextrow =  Sheet1.Cells(Rows.Count, lngCol).End(xlUp).Row + 1
        If nextrow > lngMaxNR Then lngMaxNR = nextrow
    Next
    'lngMaxNR is the highest value of nextrow for all columns

Re: Add Wordart When Print then remove after

This is untested but try:

Sub Printsh(ByRef rngSheetInfo As Range)
    Dim shpTemp As Object
 
    PrtOK = True
    On Error Resume Next
    Application.Dialogs(xlDialogPrinterSetup).Show
    ThisWorkbook.Worksheets(CStr(rngSheetInfo.Value)).PrintOut
    If rngSheetInfo.Offset(0, 1).Value < 1 Then
        With ThisWorkbook.Worksheets(CStr(rngSheetInfo.Value))
            Set shpTemp = .Shapes.AddTextEffect(PresetTextEffect:=14, Text:="Pink", FontName:="Arial Black", FontSize:=48, FontBold:=False, FontItalic:=False, Left:=200, Top:=0)
            .PrintOut
            shpTemp.Delete
        End With
        rngSheetInfo.Offset(0, 1).Value = rngSheetInfo.Offset(0, 1).Value + 1
    End If
    rngSheetInfo.Offset(0, 1).Value = rngSheetInfo.Offset(0, 1).Value + 1
    PrtOK = False
    Set shpTemp = Nothing
End Sub

Just a word of warning. Using On Error Resume Next without following it very soon with On Error GoTo 0 is very bad programming practice. Any errors that occur while your are trying to debug this piece of code will be masked.

Re: Excel mouseOver event or something else?

I just said it was an idea. I didn't say it was a good idea

Re: Call other macros using drop down list

Or go wild and use nested Case statements

Select Case Target.Address
        Case "$B$4"
            Select Case Target.Value
                Case "BerkShire"
                    Call Berkshire_1
...
            End Select
        Case "$C$4"
            Select Case...
...
        Case "$D$4"
        '// And So on...
    End Select
End Sub

Re: Excel mouseOver event or something else?

There is an idea that I think could be made to work. I don't have time to play around and write it at the moment, and what follows is probably a bit advanced for you, but someone else may grab the idea and give it a go:

You can lay a Forms Image over the cells you want to potentially have the tool-tip for. You then set the Backstyle of this to fmBackStyleTransparent. A forms object has the MouseMove event. With some care and a fair amount of coding you can work out when the mouse is over a particular cell and then bring up a shape containing your text that tracks the pointer.

Option Explicit
 
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With ActiveSheet.Shapes(2)
        .Left = X
        .Top = Y
    End With
End Sub

Take a look at this but don't be mistaken, this is not 'nearly there' to turn it into what you want requires quite a bit of work, but in theory it could be done.

Re: Change the dimensions of an array

Inside the With ActiveSheet structure, with the other assignments.

Re: Change the dimensions of an array

Dim my() As Variant
...
ReDim my(1 To .Range("I3").Value))
...

The variable my is an array, which means that it is actually more than one value, in the original case 49 values. A specific value is accessed by using an index, the index is the number that goes inside the parenthesis.

Re: Count unique entries from columns in 2 sheets.

You may be able to achieve what you want with a few Dynamic Named Ranges (DNRs) and an AdvancedFilter with a formula Criteria:

Add a new Worksheet and call it 'Unique'

Define the following 'Names':
Old, Refers To: =Sheet1!$A$2:INDEX(Sheet1!$A$2:$A$50000,COUNTA(Sheet1!$A$2:$A$50000))
New, Refers To: =Sheet4!$A$1:INDEX(Sheet4!$A$1:$A$50000,COUNTA(Sheet4!$A$1:$A$50000))
Criteria, Refers To: =Unique!$A$1:$A$2
UniqueList, Refers To: =Unique!$C$1

Then Select the Unique Worksheet:
A1: Unique
A2: =COUNTIF(Old,Sheet4!$A2)=0

Then Data > Filter > Advanced Filter and fill out the dialog as follows:
Copy to another location: Selected
List Range: Old
Criteria Range: Criteria
Copy to: UniqueList
Unique Records only: Un-checked
Then OK

Should give you a unique list on your new Worksheet.

Re: Round up to nearest multiple

Sorry, I am not allowed to receive Workbooks for Free Help forum threads.

As you have described it, this is a realtively simple issue. I have tested the formula I posted in an Excel 2003 Workbook and it functions.

Either describe how it is not working in more detail or attach your Workbook to your previous post. To attach the Workbook use Edit Post > Go Advanced > Manage Attachments. Your Workbook will need to be less than 105KB but you can zip if necessary.

Re: Round up to nearest multiple

CEILING is a standard Excel function. I have never seen Excel give an Error 509, that looks more like Open Office not recognising a formula.

Re: Call Explode Add-In from Control on User Form

You can call from VBA with:

Application.Run "Explode.xla!ShowExplodeForm"

However without modifying the code of Explode itself I don't think there is a way to 'pass' the cell reference to it. You would simply have to select the cell from the UserForm first then call it.

Re: Round up to nearest multiple

Try:
=CEILING((H30/((100-I30)/100)),0.05)

Re: I want to create a new sheet if the database contains certain number / text

Add a new Worksheet to your Workbook. Call it PrefixReference.
Add the following to that new sheet:
[ss=
-----A------ ----B-----
1 Order Prefix Sheet Name
2 S SUGAR
3 C COFFEE
4 CHM CHARM
5 SH SHIN
6 J JOKER
7 B BB ]*[/ss]

Option Explicit
 
Sub SheetFromOrderPrefix()
    Dim rgxRegExp As Object
    Dim wksDstWorksheet As Object
    Dim rngOrderNo As Range, rngPrefixList As Range, rngPrefix As Range
    Dim lngNextRow As Long
 
    Set rgxRegExp = CreateObject("VBScript.RegExp")
    With Worksheets("PrefixReference")
        Set rngPrefixList = .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
    End With
    With ThisWorkbook
        For Each rngPrefix In rngPrefixList
            Set wksDstWorksheet = ActiveSheet
            On Error Resume Next
                .Worksheets(CStr(rngPrefix.Offset(, 1).Value)).Select
            If Err.Number <> 0 Then
                .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
                With .Worksheets(.Worksheets.Count)
                    .Name = CStr(rngPrefix.Offset(, 1).Value)
                    .Parent.Worksheets("Database").Rows(1).Copy Destination:=.Rows(1)
                    .Range(.Cells(1, 1), .Cells(1, Columns.Count).End(xlToLeft)).EntireColumn.AutoFit
                End With
            End If
            On Error GoTo 0
            wksDstWorksheet.Select
        Next
        For Each rngOrderNo In .Worksheets("Database").Range("B2", .Worksheets("Database").Cells(Rows.Count, "B").End(xlUp))
            For Each rngPrefix In rngPrefixList
                rgxRegExp.Pattern = "^" & rngPrefix.Value & "\d+"
                If rgxRegExp.Test(rngOrderNo.Value) Then
                    Set wksDstWorksheet = .Worksheets(CStr(rngPrefix.Offset(, 1).Value))
                    lngNextRow = wksDstWorksheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    rngOrderNo.EntireRow.Copy Destination:=wksDstWorksheet.Rows(lngNextRow)
                    Exit For
                End If
            Next
        Next
    End With
    Set rgxRegExp = Nothing
    Set wksDstWorksheet = Nothing
End Sub

Re: Problem using RANK & COUNTIF to take into account Null Values

Just replace them with 0. If you want 0 to display as "-" then use an appropriate number format. There is probably a way to re-write the formula to take the "-" into account but is it really worth it?

Re: Password Protecting Individual Sheets

Quote from cytop;527132

you can't password protect individual sheets

Umm, thats not quite correct. You can password protect individual sheets to stop them being changed without the password, but that does not automatically mean they cannot be seen. Being protected and being visible are different issues.

If you search in the Possible Answers section below you will see several threads about protecting and hiding worksheets.