Posts by Insomniac

For the old school people the filter range starts at A2, A3 is empty , so the filter ends at row 2 regardless of the other columns data.

If you type a space in A3 the filter will extend to A7 (Service)

One solution is to ensure the first filtered column is populated to the number of rows required ,
or manually select the whole range when applying the filter, or use the "Advanced" button(the right of "filter" button).

Re: Set Focus To Application After Hiding UserForm

Its unclear here if Excel is being automated from Access or what, but in any case I believe the solution will be AppActivate.
Application.Goto will select and display a sheet and range, but the userfom will still have focus without AppActivate "Microsoft Excel".
Should work for versions 2002 up, below needs API.

Sub TestSetFocus()
    
    UserForm1.Show vbModeless
    
    'Excel will select and display, but userform keeps focus
    Application.GoTo Sheet1.Range("A1")
    
    'Application gets focus with following
    AppActivate "Microsoft Excel"
    
End Sub

Re: 4 Conditions For Conditional Formatting

Its also possible to use custom number formats to some extent, eg:

Format>Cells>Custom> [Blue][=0]#,##0;[Red][<0]-#,##0;[Green] #,##0;[Magenta]@

This would make zero values BLUE, negative numbers RED, positive numbers GREEN, text MAGENTA

Conditional Formating could also be used that would overide the cell formating, eg:

Condition1: CellValueIs 0 (Orange)
Condition2: FormulaIs: =AND(ISNUMBER(A1), A1>=100) (Aqua)
Condition3: FormulaIs: =AND(ISNUMBER(A1), A1>=10) (Lavender)

Perhaps read here for more http://www.ozgrid.com/Excel/font-formats.htm

Re: Disable X (quit) Button

There is no Application.Quit event, but you can trap WorkbookBeforeClose at an Application level.

Private Sub XlApp_WorkbookBeforeClose(Byval Wb As Workbook, Cancel As Boolean) 
MsgBox Wb.Name & " is Closing"
End Sub

Re: Disable X (quit) Button

You can do it with API, although I generally wouldnt recommend it.
Fortunately this will only effect the current application and does not persist between sessions.

Private Declare Function GetSystemMenu Lib "user32" ( _
    ByVal hwnd As Long, ByVal bRevert As Long) As Long


Private Declare Function DeleteMenu Lib "user32" ( _
    ByVal hMenu As Long, ByVal nPosition As Long, _
    ByVal wFlags As Long) As Long


Sub Xoff()
    DeleteMenu GetSystemMenu(Application.hwnd, 0), 6, 1024
End Sub


Sub Xon()
    GetSystemMenu Application.hwnd, True
End Sub

Re: Formatting Text Fails In 97 But Works In 2003

The problem with the original code is that xl97 (VB5) does not have the Replace function.

You could use SUBSTITUTE instead, ie:
change

sText = Replace(sText, "<br><br>", Chr(10))

to

sText = Application.Substitute(sText, "<br><br>", Chr(10))

Anyway your current problem is due to a bug in xl97 and CommandButtons TakeFocusOnClick property.
See here:http://support.microsoft.com/d…n-us;177527&Product=xlw97
Set the TakeFocusOnClick Property to False of the Command Button
or put in as 1st line of code:

Activecell.Activate

Re: Qualifying Workbooks And Worksheets

The original code works fine for me with a minor adjustment, no Workbook Activation is needed.
The line For Each wks In Worksheets will always refer to the Application.ActiveWorkbook without explicit qualification.
Hence: For Each wks In wkb.Worksheets
The wks object variable when fully referenced knows what its parent Workbook object is without activating it.

Sub ReferencingFixed()
    Dim wks As Worksheet
    Dim wkb As Workbook
    For Each wkb In Workbooks
        For Each wks In wkb.Worksheets
            wks.Cells(1, 2) = 5
        Next wks
    Next wkb
End Sub

Re: Application.Visible = False

I,m guessing you are looking for Application.IgnoreRemoteRequests = True to stop other workbooks opening in the excel instance you have hidden.

Be aware that this setting persists between excel sessions so it is imortant to reset it.
Try: [vba]Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'important to reset this
Application.IgnoreRemoteRequests = False
End Sub

Private Sub Workbook_Open()
'need to use ontime to allow xl to initialise fully
Application.OnTime Now, "ThisWorkbook.OnlyOneOfMe"
End Sub
Private Sub OnlyOneOfMe()
Dim XlApp As Excel.Application
On Error GoTo BAD
With Application
If Me.ReadOnly Or .Workbooks.Count > 1 Then
Me.ChangeFileAccess Mode:=xlReadOnly
Set XlApp = New Excel.Application
'XlApp.Visible = True
XlApp.Workbooks.Open (Me.FullName)
GoTo BAD
Else
'stop opening from explorer (but not from excel)
.Visible = False
.IgnoreRemoteRequests = True
UserForm1.Show
.Visible = True
.Quit
End If
Exit Sub
End With
BAD: If Err Then MsgBox Err.Description, vbCritical, "ERROR"
Set XlApp = Nothing
Me.Close False
End Sub[/vba]

Also be aware that with the Application hidden, the userform will show, and remain on the desktop, but if another application is activated your userform will be covered with no taskbar or system tray icon to select it again.

Have a look at Ivans site for info on this:
http://www.xcelfiles.com/Userform_TaskBar.html
http://www.xcelfiles.com/Userform_SystemTray.html

Or you could just use some API to set the form OnTop of everything else.

Re: Determine If Entire Column Is Selected

Keeping in mind that any given selection (using CTRL) may or may not be contiguous, or even adjacent it leaves Selection.Rows.Count open to ambiguities.

Perhaps like this would allow for multi range selections:
[VBA]Sub cols()
Dim r As Range, c As Range

For Each c In Selection.Columns
Set r = Intersect(Selection, c)
If r.Address = c.EntireColumn.Address Then
MsgBox "Entire column selected: " & _
Left(c.Cells(1).Address(0, 0), Len(c.Cells(1).Address(0, 0)) - 1)
End If
Next

End Sub[/VBA]

Re: Open Only If WS present...

With 100 or so workbooks you may want to check if the sheet exists before opening the file or it could take a long time. (It would be prudent to include functions to validate the path and the existence of the workbook as well).

I use a small function for this:[VBA]Function CheckSheetExist(Pth As String, WB As String, Sh As String) As Boolean
'(assumes the path and workbook is valid) attempt to extract a value from A1
'of the specified sheet, if we get an error the sheet does not exist
On Error GoTo NBG
If Application.ExecuteExcel4Macro("'" & Pth & "[" & WB & "]" & Sh & "'!R1C1") > "" Then
CheckSheetExist = True
Else
NBG: CheckSheetExist = False
Err.Clear
End If
On Error GoTo 0
End Function[/VBA]
to test it [VBA]Sub testit()
Dim check As Boolean
check = CheckSheetExist("C:\", "Book1.xls", "Sheet1")
MsgBox check
End Sub[/VBA]
Modifying the original code [untested] maybe like: [VBA]Sub recTestOpenAll()
'
Dim x As Integer
Dim WB As String
Dim wbk As Workbook
Dim WS As String

WS = "Sheet1" 'the sheet name to check for

For x = 1 To 100

WB = "G:\Rule Test Files\REC " & x & ".xls"

If CheckSheetExist("G:\Rule Test Files\", "REC " & x & ".xls", WS) Then

On Error Resume Next
Set wbk = Workbooks.Open(FileName:=WB)
On Error GoTo 0
If Not wbk Is Nothing Then
End If

End If
Next
End Sub[/VBA]

Re: Serial date conversion to semi string data.

One way using CDate.

MsgBox Format(CDate(38842.8287152778), "mmddyyyy_hhmmss AM/PM")

Re: Deleting hidden rows

The 1st code you posted was geting the error at Row(j).Activate, needs to be Rows not Row.

You do need to loop backwards when deleting this way to catch all the rows.
Also you dont need to Activate/Select anything.

Sub DeleteHiddenRows()
    For j = ActiveCell.SpecialCells(xlLastCell).Row To 1 Step -1
        If Rows(j).Hidden Then
            'Rows(j).Hidden = False
            'Rows(j).Activate
            'Selection.Delete
            Rows(j).EntireRow.Delete
        End If
    Next j
End Sub

The looping may get a bit slow over a large range but you can do it without looping, something like:

Sub delHiddenRows()
Dim r As Range, k As Range
    With ActiveSheet
        Set r = .Range("A1:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
        Set k = r.SpecialCells(xlCellTypeVisible)
        r.EntireRow.Hidden = False
        k.EntireRow.Hidden = True
        r.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        r.EntireRow.Hidden = False
    End With
End Sub

Re: minimise workbook / display form on startup

For xl97 modeless forms are not available so to release the WorkbookOpen event DoEvents is needed.
Try like this: in WorkbookOpen
[vba]Private Sub Workbook_Open()
UserForm1.Show '(or whatever your userform is called)
End Sub[/vba]
in UserForm
[vba]Option Explicit

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Sub UserForm_Initialize()
Dim hWnd As Long
Application.WindowState = xlMinimized

While hWnd = 0
DoEvents
hWnd = FindWindow(vbNullString, Me.Caption)
Wend

SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE

SetForegroundWindow FindWindow("xlmain", Application.Caption)

End Sub

Private Sub UserForm_Terminate()
Application.WindowState = xlNormal
End Sub[/vba]

Re: Color Format Visible Cells

It works almost instantly for me on your sample.

I only using a PIII 800mhz + xl97 for testing.

Try the 1st code & compare.

Have you got a lost of other fomulas/conditionalformats on your sheet?

Possible setting calculation to manual at the start of code & back to auto would maybe help?

Re: Color Format Visible Cells

Hello, 2 ways I can suggest:

Both these ways using the Calculation event to make it automatic, need a formula on the sheet to force it to fire.
I changed your header in A1 to:

="AUTO FILTER "&SUBTOTAL(3,A2:A1000)

Then first way: (Add code to the SheetCode Module)

Private Sub Worksheet_Calculate()
Static r As Range, s As Range
    
    On Error Resume Next ' in case no specialcells
    With Me
        If .FilterMode Then
            With .AutoFilter.Range.Columns(1)
                Set r = .Offset(1).Resize(.Rows.Count - 1)
                Set s = r.SpecialCells(xlCellTypeVisible)
            End With
        End If
        If Not r Is Nothing Then
            r.Interior.ColorIndex = xlNone
            s.Interior.ColorIndex = 35
        End If
    End With


End Sub

2nd way using some code and Conditional Formatting:
Code for Sheet Module:

Private Sub Worksheet_Calculate()
Dim crit As String


    With Me
        If .FilterMode Then
            Application.EnableEvents = False
            crit = .AutoFilter.Filters(1).Criteria1
            .Names.Add "Filt1", Right(crit, Len(crit) - 1)
            Application.EnableEvents = True
        End If
    End With


End Sub

Then use Conditional format for column A:
Cell Value Is >> equal to >> =Filt1
(and give it a format)

Remember both these codes go in the Sheet module & you need to have a formula in the sheet to make them work.

Re: Check if File is open already

Check the links in my post here:
http://www.ozgrid.com/forum/showthread.php?t=22122

Re: Determining Cells Whose Value Changed Through Each Calculate Event

Hello Justin, this may not be exactly what you want but it should give some ideas. To compare formulas values you need to keep a copy of the previous values somewhere. Example here assumes columns A:AZ possible formulas and uses Columns BA:CZ to store values as well as a static array & conditional formatting to change the cell colours.
This will change any cell with a formula in columns A:AZ if different to previous calculation.

Private Sub Worksheet_Activate()
    'force apply of conditional format & sheet calculate to initialise array
    Worksheet_Change Me.Range("A1")
    Worksheet_Calculate
End Sub


Private Sub Worksheet_Calculate()
Static a As Variant
    If IsArray(a) Then 'apply array if not 1st time columns("BA:CZ")
        Application.EnableEvents = False
        Me.Range("BA1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
        Application.EnableEvents = True
    End If
    a = Me.Range("A1:AZ200").Value
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Me.Columns("A:AZ"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        With Me.Columns("A:AZ")
            .FormatConditions.Delete
            With .SpecialCells(xlCellTypeFormulas)
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=RC[52]"
                .FormatConditions(1).Font.ColorIndex = xlAutomatic
                .FormatConditions(1).Interior.ColorIndex = 3
            End With
        End With
        Application.ScreenUpdating = True
    End If
End Sub

The application of the conditional formatting is not really needed if you happy to apply it to all the cells, but for the exercise I have made it only apply to SpecialCells(xlCellTypeFormulas). (to make that work you need to use R1C1 notaion to allow for non contiguous ranges of formulas). You will notice no looping in this code & it will execute in a split second for large ranges.

Re: Run Macro from cmd button error

Sounds like your using xl97?

See here:http://support.microsoft.com/d…n-us;177527&Product=xlw97

Set the TakeFocusOnClick Property to False of the Command Button

or put in as 1st line of code:
[vba] Activecell.Activate[/vba]

Re: UserForms with multiple monitors

I normally just use Excels Top & Left property to do it.
[vba]Private Sub UserForm_Activate()
'Position top/left of Excel App
Me.Top = Application.Top
Me.Left = Application.Left

'Approx over top/left cell (depends on toolbars visible)
Me.Top = Application.Top + 110
Me.Left = Application.Left + 25
End Sub[/vba]

Re: .xls file differs when opened via macro

When you automate excel like this "Set xlAppl = New Excel.Application" with code none of the addins or files in alt - startup dir are loaded.
Since you appear to be working from xl already I'm not sure why you are creating new instances but in any case to force the addin to load:

xlAppl.AddIns("Analysis ToolPak").Installed = False
    xlAppl.AddIns("Analysis ToolPak").Installed = True

Also you are creating new instances for each file found within the loop. This will be slowing your code down & using up comp resources. You dont indicate what data you are manipulating & how, but you will need full referencing to each App for it to work.