Posts by Tom Urtis

    Re: Extract File Name From Url


    If such a url is in cell A1 for example, then to return its file name you can use this formula in cell B1, thanks Hotpepper.


    =TRIM(RIGHT(SUBSTITUTE(A1,"/",REPT(" ",99)),99))

    Re: Internet Explorer Select All


    Quote from JerryD

    I am trying to write VBA code which will go to a web site, SelectAll, make a Copy and then close the IE connection. In my code, Set objIE = CreateObject("InternetExplorer.Application") works, objIE.Navigate "https://www.whatever.com" works, and objIE.Visible = True works. What's the objIE code for "Select All" and "Copy" ? I can't seem to find any reference to these commands in the posts anywhere.


    Tks


    JerryD


    Hello everyone, been awhile since I've posted here, just noticed this thread and wonder if this works for anyone else as it does for me, with the first macro that opens IE, then selects and copies the page's content (the primary issues as I understand the question), and the second macro will close the IE instance, presumably after pasting or something else was done in between the selection / copy and close. Sorry if I missed the point of the question if this code is not relevant, which tested no problem for me:



    Hi Dave - -


    You wrote this:


    On Error Resume Next
    ActiveSheet.AutoFilterMode = False
    On Error GoTo 0



    Why do you trap for an error with setting AutoFilterMode to False? It never causes an error if the sheet is already not in AutoFilterMode; it simply sets the sheet out of AutoFilterMode if it exists and bypasses it if not. Am I missing something? Have you ever gotten an error or entered into Error mode by using that code line? I have not. Maybe you've seen an error with that codeline in previous versions? If so, do you recall which version and / or what circumstances? I've tried to create an error with that line and never could so I just use it without the trap but maybe I'm missing something.

    Assuming your cells contain constants (that you do not want to delete formulas):


    Sub Test1()
    Dim LR As Long, LC As Integer, cell As Range
    LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    For Each cell In Range(Cells(1, 1), Cells(LR, LC)).SpecialCells(2, 3)
    With cell
    If .Interior.ColorIndex = 39 Then .ClearContents
    End With
    Next cell
    End Sub


    This avoids the unreliable UsedRange and SpecialCells LastCell range references. Also assumes by "lavender" you are referring to index #39.

    One way...modify for ListBox name, control name triggering the event, and destination sheet & range.


    Private Sub CommandButton1_Click()
    Dim x As Long
    For x = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(x) = True Then Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1) = ListBox1.List(x)
    Next x
    Unload Me 'optional
    End Sub

    Hello Michael - -


    Sorry I misunderstood that you really want to somehow manipulate all 10 keys in some fashion. Here is how you can achieve what I think you are asking.


    As you can probably tell, computers are quite fussy about numeric key manipulation. In addition, each key must be trapped by its own code (short of a class module, which I would not recommend with only 10 keys). Please follow the steps below in the exact sequence I write them:


    Step 1
    Run the macro I first gave you named Sub Restore0123(). This will ensure we are back to normal key behavior.


    Step 2
    Delete the macro named Sub Customize0123().


    Step 3
    Delete the macro named Sub Restore0123().


    Step 4
    Save your workbook. Some Excel versions require this and some do not where numeric code is involved, but we are being cautious to get it right.


    Note, at this point, you will have four macros in your module, named
    Sub MyZero()
    Sub MyOne()
    Sub MyTwo()
    Sub MyThree()
    That is OK and the way it should be, so please keep them there.


    Step 5
    Add the following code to that module:


    '**********************************************


    Sub Customize0123()
    Application.OnKey "{96}", "MyZero"
    Application.OnKey "{97}", "MyOne"
    Application.OnKey "{98}", "MyTwo"
    Application.OnKey "{99}", "MyThree"
    Application.OnKey "{100}", "MyCancel"
    Application.OnKey "{101}", "MyCancel"
    Application.OnKey "{102}", "MyCancel"
    Application.OnKey "{103}", "MyCancel"
    Application.OnKey "{104}", "MyCancel"
    Application.OnKey "{105}", "MyCancel"
    End Sub


    Sub Restore0123()
    Application.OnKey "{96}"
    Application.OnKey "{97}"
    Application.OnKey "{98}"
    Application.OnKey "{99}"
    Application.OnKey "{100}"
    Application.OnKey "{101}"
    Application.OnKey "{102}"
    Application.OnKey "{103}"
    Application.OnKey "{104}"
    Application.OnKey "{105}"
    End Sub


    Sub MyCancel()
    MsgBox "Please use either the 0, 1, 2, or 3 key.", 48, "This key is temporarily disabled."
    End Sub


    '**********************************************


    Be advised, if the message box that pops up becomes a nuisance and you don't want to keep clicking on it when you make a mistake, simply comment it out or delete that code line. That will make nothing happen when numbers 4 through 9 are pressed, which you might prefer. Therefore, essentially, that macro would look like this:


    '**********************************************


    Sub MyCancel()
    End Sub


    '**********************************************


    Step 6
    Now as before, to customize the behavior of all 10 keys, first run Sub Customize0123(). To return the keys' behavior to their normal state after your job is completed, run Sub Restore0123().


    I hope I understood your intentions correctly; if not, please post back.

    Hi everyone - -


    Well, I don't get to this board as often as I used to, but I saw this thread and wonder if perhaps there really might be a solution possible.


    Michael - -


    If I understand you correctly, for the 0, 1, 2, and 3 keys, you want to enter that number and upon entry move over one column to the right, unless you are in column E, in which case you want to automatically move to column A of the next row.


    To achieve that customized effect of the 0, 1, 2, and 3 keys, run the macro "Customize0123".
    Then do your data entry. When you are finished (or you want to take a break with all those entries!), in order to make those keys return to their normal behavior, run the macro "Restore0123".


    Place the following code in a standard VBA Module:


    '***********************************************


    Sub Customize0123()
    Application.OnKey "{96}", "MyZero"
    Application.OnKey "{97}", "MyOne"
    Application.OnKey "{98}", "MyTwo"
    Application.OnKey "{99}", "MyThree"
    End Sub


    Sub Restore0123()
    Application.OnKey "{96}"
    Application.OnKey "{97}"
    Application.OnKey "{98}"
    Application.OnKey "{99}"
    End Sub


    Sub MyZero()
    With ActiveCell
    .Value = 0
    If .Column = 5 Then
    Cells(.Row + 1, 1).Select
    Else
    .Offset(0, 1).Select
    End If
    End With
    End Sub


    Sub MyOne()
    With ActiveCell
    .Value = 1
    If .Column = 5 Then
    Cells(.Row + 1, 1).Select
    Else
    .Offset(0, 1).Select
    End If
    End With
    End Sub


    Sub MyTwo()
    With ActiveCell
    .Value = 2
    If .Column = 5 Then
    Cells(.Row + 1, 1).Select
    Else
    .Offset(0, 1).Select
    End If
    End With
    End Sub


    Sub MyThree()
    With ActiveCell
    .Value = 3
    If .Column = 5 Then
    Cells(.Row + 1, 1).Select
    Else
    .Offset(0, 1).Select
    End If
    End With
    End Sub


    '***********************************************


    Note, this assumes you want to manipulate the so-called "10-key" number pad keys, found in the far right area of most keyboards.
    If instead, you want to manipulate the numeric keyboards that run horizontally along the top of the keyboard (usually located between the letters and function keys),
    then in the Customize0123() macro, substitute (for example)
    Application.OnKey "{97}", "MyOne"
    with
    Application.OnKey "1", "MyOne"


    and in the Restore0123() macro, substitute
    Application.OnKey "{97}"
    with
    Application.OnKey "1"


    Then repeat the code line substitutions for each of the other 3 keys in both procedures, but again, only if my assumption is incorrect that it is the 10-key numbers you want to use.


    Hopefully this gets you closer to what you need. If not, sorry to intrude.



    By the way, how in the world did I inherit that emoticon with the overactive bushy eyebrows ?? Anyone know how to get rid of it? Not that it's a bad thing mind you, just curious how it got there...I must be missing something obvious in my profile settings. Thanks everyone !

    Yes it's possible. A live chart cannot exist in a shape, but you can take a picture of the chart and load it into the comment shape.


    The code below can give you the basic idea of how to do it, but you'll need to consider and modify for:
    - Path name of .gif
    - Chart name
    - Destination sheet and cell
    - Size of comment shape depending on the size of your chart.
    - If the chart data changes, the code deletes the current comment if there is one, and adds a new one, to maintain an updated look to the comment instead of a "yesterday's news" old chart.


    Be careful about text in the comment because it will be superimposed onto the chart and make for an ugly appearance, but that's up to you if maybe you leave enough empty space at the top of the chart to accommodate comment text.


    Anyway, here's something to get you started...tested fine in XL2K3 XP:


    Sub Test1()
    Application.ScreenUpdating = False
    Dim x As String, z As Range
    x = "C:\Your\File\Path\YourChartName.gif"
    Set z = Worksheets("Sheet1").Range("A20")
    On Error Resume Next
    z.Comment.Delete
    On Error GoTo 0
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Export x
    With z.AddComment
    With .Shape
    .Height = 322
    .Width = 465
    .Fill.UserPicture x
    End With
    End With
    Range("A1").Activate
    Application.ScreenUpdating = True
    End Sub

    Judie - -


    I appreciate your confidence in me so thank you for that, but there are some extremely talented people on this site who can answer questions every bit as good as I can, and better. I enjoy Dave's site but am not on it as much as I'd like, so for the fastest response, you'd be best served by directing your questions to anyone & everyone instead of to just me or any one person. Anyway, hope this modified code works out for you. Have a nice evening.

    If you mean you want the 3 dependent comboboxes (Location, Results, and Observations) to show the same drop-down items when the Account combobox is changed, then the code below would do that.


    One note, the code is longer than it otherwise would be if your combo boxes were named with the default 2, 3, and 4 suffix because we could place an array in the macro based on the rightmost character of the control name passed by an Integer variable, but the way you named them actually works out better for you because you can tell by the name what the control is for. A With structure for each control helps with the size and efficiency. Sometimes, short code is not always the best code for the big picture, as you have demonstrated.


    And lest some purists fret, I know While Wend is outdated but I used it anyway.


    Replace your current code with this, if all 3 are to have the same items upon change to cboAccount:



    Private Sub cboAccount_Change()
    Dim SourceSheet As Worksheet, i As Integer


    With cboLocation
    Set SourceSheet = Worksheets("Data")
    i = 2
    .Clear
    While IsEmpty(SourceSheet.Cells(cboAccount.ListIndex + 1, i)) = False
    .AddItem SourceSheet.Cells(cboAccount.ListIndex + 1, i)
    i = i + 1
    Wend
    .ListIndex = 0
    End With


    With cboResults
    Set SourceSheet = Worksheets("Data")
    i = 2
    .Clear
    While IsEmpty(SourceSheet.Cells(cboAccount.ListIndex + 1, i)) = False
    .AddItem SourceSheet.Cells(cboAccount.ListIndex + 1, i)
    i = i + 1
    Wend
    .ListIndex = 0
    End With


    With cboObservations
    Set SourceSheet = Worksheets("Data")
    i = 2
    .Clear
    While IsEmpty(SourceSheet.Cells(cboAccount.ListIndex + 1, i)) = False
    .AddItem SourceSheet.Cells(cboAccount.ListIndex + 1, i)
    i = i + 1
    Wend
    .ListIndex = 0
    End With


    End Sub

    You don't need to re-set the ListIndex on every initialization just like you don't need to clean the windshield of your car before every trip. But it just starts things out a little neater so I posted it for your convenience. The essence of the code is the Change event, and I'm glad it worked out for you. Have a nice day.

    One way, using a different approach than what you are using, but it works when tested.


    Step 1
    In your first combobox (the one you apear to have named cboAccount), have this be your RowSource property:
    Data!A1:A3
    Generally it is a good practice to avoid using the RowSource property but with only 3 it'll be OK.


    Step 2
    In your other combobox (named cboLocation it looks like), clear any RowSource property you may have.


    Step 3
    Add a sheet to your workbook and name it Data. You can hide it later. In cell A1, enter Arboretum, in A2 enter Botanic, and in A3 enter Moraine. In rows 1:3 starting in column B, list your dependent items across for each Account. Example, in B1 enter Bobolink, in C1 enter CA Lk, in D1 enter Eur Mdw, and so on. In B2 enter N Pond, in C2 enter N Side, in D2 enter NW Corner. In B3 enter Nat. Pond, in C3 enter SW Pond.


    Step 4
    Place the following code in your userform module and you are good to go, assuming I have the control names properly identified.



    Private Sub UserForm_Initialize()
    cboAccount.ListIndex = 0
    End Sub


    Private Sub cboAccount_Change()
    Dim SourceSheet As Worksheet
    Dim i As Integer
    Set SourceSheet = Worksheets("Data")
    i = 2
    cboLocation.Clear
    While IsEmpty(SourceSheet.Cells(cboAccount.ListIndex + 1, i)) = False
    cboLocation.AddItem SourceSheet.Cells(cboAccount.ListIndex + 1, i)
    i = i + 1
    Wend
    cboLocation.ListIndex = 0
    End Sub



    The reason for the extra sheet is, although it is not necessary, you have a lot of items to load, and it will be easier for you or someone else to administrate that list if it is on a worksheet and not in a userform module inside Upper and Lower bound arrays, which is unfamiliar territory for most people.

    You don't need VBA to do this, just click on the column A header (or select the used range in column A or whatever column you deem as the determinant column), and then click on Edit > GoTo > Special > Blanks > OK; Edit > Delete > select Entire Row > OK.


    If you really want a VBA solution, no problem, here's a one-liner:


    Sub Test1()
    Range(("A1"), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End Sub

    Yes you do need to save the workbook first, which makes sense because to save as, you first need to save from.


    "SaveAsUI" is the menu option SaveAs wrapped into the Excel application's built-in User Interface (hence the UI suffix).


    How the code works you ask? There are 28 workbook and worksheet level events that are standard in VBA coding. One of them is BeforeSave, which has two Boolean (that is, True / False) arguments...one for saving as, and one for cancelling the save action altogether. I used a Select Case structure to interrupt the save action if the Save As menu item was clicked on. With True being the case (Save As was clicked on by the user, not just Save), a message box informs the user that they cannot save as. Also as you can see, the second Boolean argument, Cancel, was set to True to cancel the Save As action.


    This is VBA (Visual Basic For Applications). How you can learn code like this is to read books on the subject, look in on newsgroups like this one, practice on your own, and like any other language, it will come to you eventually. Be patient though. As anyone will tell you, no matter how many years you work with this stuff, there is always something new to learn.

    Place this in your workbook module and see if it accomplishes what you are after. To easily access your workbook module, find the little Excel workbook icon near the upper left corner of your workbook window, usually just to the left of the File menu option. Right click on that icon, left click on View Code, and paste the following procedure into the large white area that is the workbook module. Press Alt+Q to return to the worksheet.


    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Select Case True
    Case SaveAsUI
    MsgBox "Sorry, you may not ''Save as'' this workbook." & vbCrLf & vbCrLf & "You may only save it, keeping its original name.", 48, "''Save as'' not allowed."
    Cancel = True
    Case Else
    Exit Sub
    End Select
    End Sub

    You will need VBA to do that. Here is a macro that asks how many copies you want to print, and then does the dirty deed.


    Sub PrintLotsaOne()
    Dim PrintQuantity As Variant 'to handle non numeric input box entry
    PrintQuantity = InputBox("Please enter the quantity of copies you want to print:", "How many copies of this sheet you wanna print?")
    If PrintQuantity = "" Or Not IsNumeric(PrintQuantity) Or PrintQuantity < 1 Then
    MsgBox "You entered nothing or a non number.", 48, "Print cancelled."
    Exit Sub
    Else
    Application.ScreenUpdating = False
    Dim i As Integer
    For i = 1 To PrintQuantity
    With ActiveSheet
    .PageSetup.CenterFooter = "Print-out number " & i & " of " & PrintQuantity & "."
    .PrintOut
    End With
    Next i
    Application.ScreenUpdating = True
    End If
    End Sub

    Recording a macro will unfortunately not allow you to define a dynamic range, where for example in your case, when the quantity of rows changes.


    Try this instead: declare a range variable, such as DataRange, and set it for a dynamic row count.


    The example below shows how to do it for A1:G whatever, so maybe you can start using this right away.


    Dim DataRange As Range
    Set DataRange = Range(("A1"), Cells(Rows.Count, 1).End(xlUp).Offset(0, 6))
    'Now use DataRange to refer to the dynamic range from A1:G whatever. Example:
    DataRange.Select

    Well if you still have time in your busy schedule after people were graciously trying to hep you, this custom validation formula would work, assuming the specified character length is 7.


    =AND(LEN(A1)=7,ISTEXT(A1))

    Play around with this one-liner. The smaller the number (currently 25 as shown here), the closer to the left you will move the header value. Increasing the number will move the header value towards the right.


    ActiveSheet.PageSetup.LeftHeader = String(25, " ") & "Moveable header"