Posts by Fencliff

Re: Use Of Hash Sign In Macro

Quote from Dave Hawley

Oh, yes, soooo much easier to read. Except the 1 letter variables like x, y, i, j etc.

lRows or lngRow is so much easier to read and debug.

I guess that's a matter of taste. I generally write pretty strict Systems Hungarian in VB and Hungarian/RVBA notation in VBA, but my indexes for walking arrays are in most cases i, j and k, and on the rare occasion I need to nest another loop, m, n and p.

Once get used to i being the first dimension, j the second and k the third, it is in my opinion much easier to read than lngRow, lngCol and lngDepth.

I do agree that in VB where the syntax consists of semantic proper case/camel case words, using a single character variable looks a little out of place, but coming from other languages where the syntax is much less verbose, it feels much more natural to iterate with "i" than for instance with "loop_index".

Re: Extract Zip Files Without WinZip

It can be done, for example here by Ron De Bruin:

http://www.rondebruin.nl/files/windowsxpunzip.txt

By the way, it was the first hit on Google search "VBA Windows XP Zip"

Re: Save Workbook To Multiple Paths

Hi,

There are two things wrong here.

If Franklin is supposed to be the filename, and not a variable, then you need to enclose it in quotes: "Franklin". Secondly, you should specify the file extension, for instance "Franklin.xls"

Re: Autofilter Code Failing On Shared Workbook & Protected Sheet

Dave, quoting my own post:

Quote

- When I protect the sheet, I do allow the user to use autofilter. Consequently, Sheet.Protection.AllowFiltering and Sheet.EnableAutofilter both are on. Still, I keep getting the error.

Thanks, but the solution isn't quite that simple.

Hi all,

I have a problem I can't figure out. I have a protected worksheet with some macros running on it, and I have been requested to make the workbook shared. Trying to implement this, I keep getting the standard "1004 You cannot use this command on a protected sheet" error when applying an autofilter. Here is what is making this problem a little tricky:

- As the workbook is shared, I cannot do Protect UserInterfaceOnly because you can't change the protection settings on a shared workbook without unsharing it. Needless to say, I cannot unshare the workbook.

- When I protect the sheet, I do allow the user to use autofilter. Consequently, Sheet.Protection.AllowFiltering and Sheet.EnableAutofilter both are on. Still, I keep getting the error.

The failing line of code is:

shData.Range("_filterDataBase").AutoFilter lngField, strArg

where shData is the codename of the sheet, lngField is the number of the field and strArg is the filtering criteria.

My guess is, that the error comes from the fact that (for some silly reason) in VBA the .AutoFilter method is used to create a new filter, not only to use an existing one. The members of Sheet.AutoFilter.Filters collection are read-only, and cannot be used to modify the existing filter.

I would be very grateful if somebody could either clarify that using .AutoFilter on a protected worksheet is something that simply cannot be done, or point out what I am doing wrong. Also, if I am wrong in any of my above assumptions of "can't do" nature, please correct me.

Re: Extract Date From File Name & Format

Thanks for assisting, Dave. Here is a version of the function that will work with any standard extension (1 to 4 characters). walugi, read the verbose comments carefully, and I'm sure you'll get how it works.

Sub Example()
'   This is an example how to use the function in your code.


    Dim dtmDate         As Date
    Dim strYourFileName     As String
    
    strYourFileName = "WhateverFileNameWouldBe20070830.ext"
    
'   Call the function with your filename as the argument, and the
'   date derived from the filename ("20070830" in this case) will
'   be stored into the variable dtmDate as a valid date format
'   you can use to .Find stuff.
    dtmDate = fDateFromFile(strYourFileName)
End Sub


Public Function fDateFromFile(ByVal strFileName As String) As Date
'   Returns a date from a string where the date is in the end
'   of the filename. It does not matter what the rest of
'   the filename is, as long as before the extension the last charaters
'   are a valid date in  format "yyyymmdd"
     
    Dim lngYear         As Long
    Dim lngMonth        As Long
    Dim lngDay          As Long
    Dim lngStopPos      As Long
    
'   Find the position of the character "." just before the extension,
'   i.e. ".xls" or ".jpeg". This assumes the extension is no more than
'   4 letters long, which in practice it never is. We only look from the
'   last 5 letters, because the filename itself might contain the char "."
'   and we only want the position of the extension separator, not other
'   stops.
    lngStopPos = InStr(Len(strFileName) - 5, strFileName, ".")
     
'   Get the two characters (dd) just before the extension separator
'   "." and convert them to a number format.
    lngDay = CLng(Mid(strFileName, lngStopPos - 2, 2))


'   Get the two characters (mm) before the previous characters and
'   convert them to a number format
    lngMonth = CLng(Mid(strFileName, lngStopPos - 4, 2))


'   Get the four characters (yyyy) before the previous characters and
'   convert them to a number format.
    lngYear = CLng(Mid(strFileName, lngStopPos - 8, 4))
     
'   Compile the three above numbers with the DateSerial function into a
'   date (yyyy+mm+dd = date)
    fDateFromFile = DateSerial(lngYear, lngMonth, lngDay)


End Function

Re: Extracting Then Formatting A Date From A Filename

A real simple solution:

Private Function fDateFromFile(ByVal strFileName As String) As Date
'   Returns a date from a string where the extension is three
'   characters long, and the date is in the end of the filename,
'   in format yyyymmdd.


    Dim lngYear         As Long
    Dim lngMonth        As Long
    Dim lngDay          As Long
    
    lngDay = CLng(Mid(strFileName, Len(strFileName) - 5, 2))
    lngMonth = CLng(Mid(strFileName, Len(strFileName) - 7, 2))
    lngYear = CLng(Mid(strFileName, Len(strFileName) - 11, 4))
    
    fDateFromFile = DateSerial(lngYear, lngMonth, lngDay)
    
End Function

As you can see from the comments in the code, this will only work with filenames that have a 3-letter extension. Nevertheless, if you study how it works, it should get you started.

Re: Not a Valid Add-in Message Loading Add-in

The error you are getting is because the IsAddin property of ThisWorkbook object is set to False. This property has the side effect of making the workbook hidden (not using the Visible property of the Window object, so there is no way you can manipulate that aspect of the property).

When you save a workbook as .xla in the "regular way", Excel saves a copy of the active workbook as xla, and keeps the regular .xls (or unsaved) workbook open for editing. Now, I don't know if there is a native way to do this through the FileDialog, and if there is, that method would of course be the best option.

If there isn't, as a workaround you check if the user is trying to save an addin by accessing the FilterIndex property of the FileDialog object (the FilterIndex for an .xla is 34). If not, then proceed with Execute.

If she is trying to save an addin, you can get the intended filename and path from the FileDialog's SelectedItems property and instead of Execute, do this:

1. Set the workbook's IsAddin property to True
2. Use Workbook.SaveCopyAs with the file name you retrieved from SelectedItems
3 Set the workbook's IsAddin property to True

Something like this:

Sub CustomSaveAs()
    Dim wbkSaveMe         As Workbook
    Dim objDialog         As FileDialog
    
    Set wbkSaveMe = ActiveWorkbook
    Set objDialog = Application.FileDialog(msoFileDialogSaveAs)


    With objDialog
        If .Show = -1 Then
            Select Case .FilterIndex
                Case 34
                    Application.ScreenUpdating = False
                    wbkSaveMe.IsAddin = True
                    wbkSaveMe.SaveCopyAs .SelectedItems(1)
                    wbkSaveMe.IsAddin = False
                    Application.ScreenUpdating = True
                Case Else
                    .Execute
            End Select
        Else
            'Do Nothing
        End If
    End With
End Sub

I know it's a bit of a workaround, but at least it works.

Re: Maximum Length For A Macro

Whoa, a 2000 line procedure! That has to be a pain to maintain.

My biggest VBA program is about 2500 lines, not including comments, but that is split to 62 different procedures in standard and class modules, averaging to about 40 lines of code per procedure. The average lenght of the procedures is dragged down by some basic string, date and file handling functions and let-get-set statements, but in general, no procedure exceeds the 100 line limit.

Here's a few hints you might consider incorporating in your coding:

Any task you need to perform more than once should be it's own function. Sometimes when you only need to something once, writing and calling a function still pays off, because you can declare all the necessary variables to perform the tasks within the function, and you can have them destroyed immediately, which will save your memory resources.

Write as general functions as possible, so they can be reused. If you need to for instance extract a pattern from a string using regular expressions, don't hardcode the pattern into the function, but pass it as an argument. That way you have a wrapper function that you can call with a single line of code from any procedure you ever write. This also achieves the fact that as you use a procedure, you start coming up with new ideas on how to do it better, discover bugs or errors, that you can then fix, and the overall quality of your code will improve over time. Look into MZ-Tools to start your own code bank.

As a rule of thumb, each function should do exactly one thing. This will increase the reusability of your code. If you ever find yourself returning multiple results ByRef, you probably should do it with separate functions anyway.

Similarly, if you need to do formatting for a data table, write a separate sub to do it. After that, when you need to get data from a database to the sheet, have a separate function to create the database connection, etc. In general the main procedure you or your users call should be a set or directions, and the actual low-level handling should be for the most part done by functions and subprocedures.

Just my two cents.

Re: Transfer Cells Values To Cell Comments

Quote from error#9

Fencliff and JIUK, Thank you both so much!
Fencliff / or anyone in RE to the .xla version, how do i get it NOT to put a comment if there is nothing in the cell, at the moment i need to copy large ranges but there is some blanks, and its creating a comment for a blank!

any ideas?

I updated the code in my previous post, and also updated the attachment. Now it does not create empty comments and if cell already has a comment, it replaces it.

You can either uninstall the addin, load the attachment and reinstall it, or easier, replace all the code in the module modPasteAsComment with the updated code above.

Re: Autofilter, Vba

Instead of looping through 58 autofilters, it might be more economical to first reset all filters, and then set the fields 2 and 3 again:

With ActiveSheet
        If .FilterMode Then
            .ShowAllData
        End If
        
        With .AutoFilter.Range
            .AutoFilter Field:=1, Criteria1:=State
            .AutoFilter Field:=2, Criteria1:=InType
        End With
    End With

Re: Paste Cells As Comments

I figured that sooner or later I'll have to convert a number of cell values into comments as well, so I went ahead and added it to my personal addin. I also made a separate addin to easily create and destroy the context menus. Just download the attachment to your computer and use Excel's Tools > Add-ins menu to install it.

Here is the source code, the first bit is the event code that creates and deletes the right-click context menu item when you install or uninstall it:

Option Explicit


Private Const cstrCaption As String = "Paste As Comment"
Private Const cstrOnAction As String = "PasteAsComment"


Private Sub Workbook_AddinInstall()


    Dim cmdNewItem As CommandBarControl
    
    On Error Resume Next
    Application.CommandBars("Cell").Controls(cstrCaption).Delete
    On Error GoTo 0
    
    Set cmdNewItem = Application.CommandBars("Cell").Controls.Add
    
    With cmdNewItem
        .Caption = cstrCaption
        .OnAction = cstrOnAction
        .BeginGroup = True
    End With
End Sub


Private Sub Workbook_AddinUninstall()
    On Error Resume Next
    Application.CommandBars("Cell").Controls(cstrCaption).Delete
    On Error GoTo 0
End Sub

And this bit is the function that takes the cell values and "pastes" them as comments:
*Updated on 24-08-2007*

Option Explicit


Sub PasteAsComment()
    On Error GoTo PasteAsComment_Error


    Dim strClipBoard        As String
    Dim astrClipBoard()     As String
    Dim lngRowCount         As Long
    Dim lngColCount         As Long
    Dim i                   As Long
    Dim rngTarget           As Range
    Dim rngCurrCell         As Range
    Dim objClipBoard        As DataObject
    
    Set objClipBoard = New DataObject
    objClipBoard.GetFromClipboard
    strClipBoard = objClipBoard.GetText
    
    lngRowCount = InstrCount(strClipBoard, Chr(13))
    lngColCount = InstrCount(Left(strClipBoard, InStr(1, strClipBoard, _
        Chr(13))), Chr(9)) + 1
    
    strClipBoard = Replace(strClipBoard, Chr(10), "")
    strClipBoard = Replace(strClipBoard, Chr(13), ";")
    strClipBoard = Replace(strClipBoard, Chr(9), ";")
    
    astrClipBoard = Split(strClipBoard, ";")
    
    Set rngTarget = Selection.Cells(1).Resize(lngRowCount, lngColCount)
    
    For i = LBound(astrClipBoard) To (UBound(astrClipBoard) - 1)
        If Len(astrClipBoard(i)) Then
        
            Set rngCurrCell = rngTarget.Cells(i + 1)
            
            With rngCurrCell
            
                If HasComment(rngCurrCell) Then
                    .Comment.Text astrClipBoard(i)
                Else
                    .AddComment astrClipBoard(i)
                End If
                .Comment.Shape.TextFrame.AutoSize = True
                .Comment.Visible = False
            End With
            
        End If
    Next i
    
    Set objClipBoard = Nothing
    On Error GoTo 0
    Exit Sub
    
PasteAsComment_Error:
    Set objClipBoard = Nothing
    
    Select Case Err
    Case -2147221404
        MsgBox "The clipboard is empty, or the data is not text"
    Case Else
        Err.Raise Err
    End Select
    
End Sub


Function InstrCount(ByVal strSearchIn As String, _
           ByVal strFind As String) As Long
    If Not (Len(strSearchIn)) = 0 Then
        InstrCount = UBound(Split(strSearchIn, strFind))
    End If
End Function


Function HasComment(ByVal rngCell As Range) As Boolean
    On Error GoTo HasComment_Error
    
    If Not rngCell.Comment.Text = "" Then
        HasComment = True
    Else
        HasComment = False
    End If
    
    On Error GoTo 0
    Exit Function
HasComment_Error:
    HasComment = False
End Function

I tried to make it behave like an excel paste. If you copy an area of let's say 3x4 cells and select an area of 2x1 and paste, it will still fill the 3x4 starting from the top left corner of the selected area. What you cannot do is to copy a single cell, and then paste the same comment into multiple cells.

There isn't much error handling, apart from checking whether the clipboard is empty and that the data is suitable for using as a comment, so I cannot guarantee that there will be no errors.

Hope this helps,
Fencliff

Re: Add New Worksheet With Event Code

If you take Dave's advice, and use a worksheet template, I would also suggest that you raise your events to application level. Proliferation of same code to multiple worksheets will create more work for you, when you need to maintain the code. Build a custom class to handle your worksheet events, and in your template simply set reference to the class.

While we are on the topic of Chip Pearson, he has written a short article on the above, if you're not accustomed to working with class events. See: http://www.cpearson.com/excel/AppEvent.htm.

Re: Change Text To Proper Case But Keep 2&3 Letter Words As Upper

Hi trebormint,

Maybe something like this:

Public Function fProper(ByVal strInput As String) As String


    Dim strOutput       As String
    Dim astrWords()     As String
    
    astrWords = Split(strInput, " ")
    strOutput = ""
        
    For lng = LBound(astrWords) To UBound(astrWords)
        Select Case Len(astrWords(lng))
            Case Is = 2, 3
                'Do Nothing
            Case Else
                astrWords(lng) = Application.WorksheetFunction.Proper _
                    (astrWords(lng))
        End Select
        
        strOutput = strOutput & astrWords(lng) & " "
    Next lng
    
    fProper = Trim(strOutput)
    
End Function


'-------------------------------------------------------


Private Sub loopProper()


    Dim rngArea         As Range
    Dim rngCell         As Range
    Dim strColumn       As String
    
    strColumn = "A"
    
    Set rngArea = Range(strColumn & 1, Range(strColumn & 65536).End(xlUp))
    
    For Each rngCell In rngArea
        If Not IsEmpty(rngCell) And Not IsNumeric(rngCell) Then
            rngCell.Value = fProper(rngCell.Value)
        End If
    Next rngCell
    
End Sub

The function fProper converts any string passed to it into Proper Case, except for 2 and 3 letter words. You can either call it from your macro or use it as a worksheet function.

The sub loopProper is just an example how you might use this in your own macros to loop through a number of cells and convert them all.

Re: Write Data To Word

Have you set reference to the Word library?

If you haven't, in VBE go to Tools > References and tick the Microsoft Word 11.0 Object Library reference.

Re: OnTime Method Opening Workbook

Hi,

Maybe it is because I've spent all morning going through somebody else's illegible legacy code, but the names Limpa, Salva and Tempo are really brushing me the wrong way. I don't want to nitpick, but a good idea for the future would be to give your procedures proper, descriptive names in plain English, so if anybody ever needs to read your code (like we do know), they would have some idea what's going on.

Re: Count By Criteria But Only Non-Contiguous Occurences

Here is something I've used to do similar things in the past

Public Function fCountOccurrences(varItemToCount As Variant, _
    rngLookIn As Range) As Long


    Dim rngCell         As Range
    Dim lngCounter      As Long
    
    lngCounter = 0
    
    For Each rngCell In rngLookIn
        If rngCell.Value = varItemToCount And _
            Not rngCell.Offset(1, 0).Value = varItemToCount Then
            lngCounter = lngCounter + 1
        End If
    Next rngCell
    
    fCountOccurrences = lngCounter


End Function

It loops through every cell in the range and evaluates each cell and the cell below it, so it's not optimal for really long lists. You can call it in VBA to return the count as Long:

fCountOccurrences(NumberOrTextYouAreCounting, RangeToCountIn)

Or put it in your worksheet module and call it from the sheet, i.e.

=fCountOccurrences("S"; A1:A100)

Re: Check If Workbook Open If Not Open It

I use:

Private Function fBookIsOpen(strBookName As String) As Boolean


    Dim wbkBook As Workbook


    On Error Resume Next


    Set wbkBook = Workbooks(strBookName)
    If Err = 0 Then fBookIsOpen = True _
        Else fBookIsOpen = False


    On Error GoTo 0
End Function

And Then

If Not fBookIsOpen Then Workbooks.Open ...

Re: VB GrabData Equivalent in VBA

psilan,

Looks like you're using the bit of code found at:
http://www.tek-tips.com/viewthread.cfm?qid=1360516&page=6

If this is correct, then GrabData is not a method, the poster in that thread has simply used a variable GrabData to store the value he "grabs" from a sheet to later purge it into another cell.

Nor has it anything to do with VB.

Re: VB GrabData Equivalent in VBA

I would be interested in knowing more as well. Truth to be told, I was always a hack of a VB programmer, but regardless I've never used the GrabData method, and searches in MSDN Library didn't give me any clarifications.