Free Microsoft Excel 2013 Quick Reference

Run a macro when worksheet opens Results

I have a series of macros, the first of which askes the user to save two other workbooks by pulling up the "Save As" dialog box. Once they've hit the last "Save" a combo box allows them to pick a region they want to work on. My problem is that my combo box comes before the Save As box goes away, and I don't want my users to be seeing the Save As box the entire time the macro is running.

I tried adding a timer to wait for the SA box to go away, but that's a very inefficient way to time it. Is there a way to trigger my next macro (the combo box) by looking at when the SA dialog box finishes?

I've posted my current code below. I've tried setting a timer, but since I have 20 different users on machines of varying speeds I don't know exactly where to set it.

First part of code (workbook open). After the SaveAPR, I have a macro perform substitutions in another spreadsheet, then I load my popup.
Private Sub Workbook_Open()
Run "SaveAPR"
Run "FilterPRS"


Load Active_Pos_Rev_Cklist
Active_Pos_Rev_Cklist.Show
        
End Sub
Next part. Notice I set a timer at the end of the SaveAPR code. I don't know if that's the best place for it.
Sub SaveAPR()

MsgBox "Please save these reports to your desktop as" & vbCrLf & "the following names to be used by
the macro." & vbCrLf & vbCrLf & " Save the Active Position Report as APR.xls" & vbCrLf &
vbCrLf & "      Save the ESS Report as ESS.xls"
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
           
       ' Store the Activeworkbook in a variable.
       Set aw = ThisWorkbook
           For Each WB In Workbooks
           If WB.Name <> "PERSONAL.XLS" And WB.Name <> "Active Position Checklist.xls" Then
                       'activate and show the Save As dialog box.
                   WB.Activate
                   Application.Dialogs(xlDialogSaveAs).Show
           End If
           Next
    
       aw.Activate   ' Activate the original Activeworkbook.
       Application.Wait Now + TimeSerial(0, 0, 5)
    Sheets("Sheet1").Activate
    End With
   End Sub
Sub FilterPRS()
 
Dim SrcWkb As Workbook
Dim Columns As Range
        Set SrcWkb = Workbooks("APR.xls")
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        
        Dim av1         As Variant
    Dim av2         As Variant
    Dim i           As Long

    av1 = Array("PRS91", "PRS94", "PRS99")
    av2 = Array("510", "511", "588")

    With SrcWkb.Worksheets("Sheet1")
        For i = 0 To UBound(av1)
            .Columns("P").Replace What:=av1(i), Replacement:=av2(i), _
                                    Lookat:=xlPart, _
                                    MatchCase:=False, _
                                    SearchFormat:=False, ReplaceFormat:=False
        Next i

        .Columns("M").NumberFormat = "0.00"
        
    End With

            
   
    Set SrcWkb = Nothing
    Set av1 = Nothing
    Set av2 = Nothing
    Set wSheet = Nothing
          
    End With
   
End Sub
I appreciate any help I can get on this. Thanks in advance.

I have a problem with my workbook I was hoping someone here may be able to solve. I am trying to copy data (the percentage results of a validation list) from one sheet and then post that data to another sheet. The second sheet has a column of dates and I would like the percentages to paste into the cells that correspond to the current date. Once this is accomplished, I will use the data to plot a chart showing values by date.

I have attached the workbook (sans confidential material) for reference. The workbook contains four sheets, the first two ("Cover Sheet" and "Instructions") can be ignored as they have no functionality or relevance to this situation. The third sheet ("M.A.C. & GoNoGo") contains the validation list that I am trying to plot the data for (the one on the left, under the cell with "status" written in it). The fourth worksheet ("projected") is where I would like the data to be pasted.

I have used a simple reference formula to place the current percentage results of the validation list into a pair of cells [L16:M16] on the fourth sheet (so as to have all necessary data present on the fourth sheet, I figured it would make for easier coding). Those cells are next to a cell [K16] that displays the current date (I though that might be useful for a MATCH or INDEX formula). There are four columns [B through E] that have headers in row 2. The first column ("Date Entered") contains a list of dates, the second column ("Milestone") contains values based on formulas (please ignore this column, it is not relevant to this situation), the third column ("Complete %") is where i would like the data from cell L16 to be pasted, the fourth column ("Not Complete %") is where i would like the data from cell M16 to be pasted. Again, I would like this data to be pasted in the row corresponding to the current date (found in the list of dates in column B under "Date Entered").

I have been attempting (and failing spectacularly) to create a macro to achieve these goals. I had tied the macro to run when a button on sheet 3 is clicked (big gray button right in the middle, has "Chart Data" written on it). I absolutely need the macro to run when that button is clicked, so please keep that in mind if attempting to assist.

I have left the remnant of the seriously butchered code that i took from another workbook and attempted to modify. I don't think it will be helpful, but it might be pretty funny to see.

FYI (as you will be able to tell from looking at the doc) I am not an advanced excel user nor am I very capable at coding VBA. I am very open to and grateful for tips or revisions on the rest of the document too (if any glaring errors/problems are noticed).

Thanks very much in advance,
dheiland

P.S. If any more information is required, please ask and I will do my best to better explain what it is I need.

I've been helping another user create a workbook that dynamically adds, renames and deletes worksheets from a "Main Sheet".

I have got the whole thing figured out and running to satisfaction, except...

The macro runs fine if the Visual Basic Editor is open. If the editor is closed while the macro is run, I get "Runtime Error '9': Subscript out of range"

Any ideas what could be casing this? The errors occur when attempting to add sheets.

Here's my "UpdateAll" macro that is having the issues:

Sub UpdateAll()
    
    Dim SheetsAddRename As Range
    Dim shts As Worksheet
    Dim SheetTest As String
    Dim RowsDelete As Range
    
    For Each SheetsAddRename In Sheets("Main Sheet").Range("C2:C22")
        SheetTest = False
        If SheetsAddRename = "" Then
            Sheets("Main Sheet").Activate
            Call DeleteRows
            Call Resync
            Exit Sub

        Else
            
            For Each shts In ThisWorkbook.Worksheets
                If shts.CodeName = SheetsAddRename.Offset(0, -1) And Sheets("Main
Sheet").Range(SheetsAddRename.Address).Offset(0, 1).Value = "" Then
                    shts.Name = SheetsAddRename
                    SheetTest = True
                ElseIf shts.CodeName = SheetsAddRename.Offset(0, -1) And Sheets("Main
Sheet").Range(SheetsAddRename.Address).Offset(0, 1).Value <> "" Then
                    Sheets(SheetsAddRename.Value).Delete
                    SheetTest = True
                End If
            Next shts
            
            If SheetTest = False And Sheets("Main Sheet").Range(SheetsAddRename.Address).Offset(0, 1).Value =
"" Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetsAddRename.Value
                SheetsAddRename.Offset(0, -1) = ActiveSheet.CodeName
            End If
            
        End If
        
    Next SheetsAddRename

End Sub
It seems to break-down here:
If SheetTest = False And Sheets("Main Sheet").Range(SheetsAddRename.Address).Offset(0, 1).Value =
"" Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetsAddRename.Value
                SheetsAddRename.Offset(0, -1) = ActiveSheet.CodeName
            End If
When it goes to update the Main Sheet with the new worksheet's codename, ActiveSheet.CodeName seems to be blank.

Again, this only happens if the Visual Basic Editor is not open. It is as if excel cannot get the codename of a sheet if the editor is not open.

Any help would be much appreciated.

Hello there and thank you very much for any help received in advance. I have only recently started to learn VBA and have been putting it to practice in creating userforms to help people at my work to be able to timetable more quickly.

I have realised however that in many cases the basic code that I have been using could often be improved. However in the sections below I have not been able to work this out for myself. This needs to be done as after a large number of worksheets exists excel gradually gets slower and slower when running the macros.

Please could anyone help?

Macro 1

Private Sub CommandButton1_Click()
    oldSheet = ActiveSheet.Name
    Sheets("Schedule A GE2").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets("Schedule B GE2").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets("Schedule A GE1").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets("Schedule B GE1").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets(oldSheet).Activate
End Sub
Macro 2

Private Sub CreateButton_Click()

NewSheet = NameBox.Text
SillyThing = "Name: "
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = NewSheet
    Range(" A5").Value = SillyThing & NameBox.Text

End Sub


The second of the two macros is the real issue as due to how excel apparently names worksheets the macro will stop working after some time and the only way I have worked out to get it working again is to save and re-open the workbook. It also takes some time to run as I am a complete noob with the dim function.

Many thanks,

Tom

Hello I am currently writing a macro that will take one or more files that I choose and will copy them onto a template which will then generate a graph.
Since the files are saved in different formats I created an if loop that determines which file type it is then calls on the apporpriate subroutine.

For i = LBound(Filename) To UBound(Filename)
    msg = msg & Filename(i) & vbCrLf
    On Error GoTo skip:
    Workbooks.Open Filename(i)
    Set temp = Application.ActiveWorkbook
    
    If ActiveSheet.Cells(1, 1) = "Tool Serial #" Then
        Call chart_old_1
    ElseIf ActiveSheet.Cells(1, 1) = "Test Type :" Then
        If ActiveSheet.Cells(1, 2) = 1 Then
            Call chart_1_pressure
        ElseIf ActiveSheet.Cells(1, 2) = 2 Then
            Call chart_1_shear
        End If
    Else
    MsgBox ("Invalid file format.")
    End If
skip:
Next i
which when i had just a message box in each sub routine it worked fine. Now writing the subroutines I am getting a error inside a the following subroutine.

'check test type
test_type = temp.Worksheets("Test Results").Cells(1, 2)
client = temp.Worksheets("Test Results").Cells(2, 2)
location = temp.Worksheets("Test Results").Cells(3, 2)
well_name = temp.Worksheets("Test Results").Cells(4, 2)
sa_number = temp.Worksheets("Test Results").Cells(5, 2)
color_code = temp.Worksheets("Test Results").Cells(6, 2)
tool_sn = temp.Worksheets("Test Results").Cells(7, 2)
tool_type = temp.Worksheets("Test Results").Cells(8, 2)
test_operator = temp.Worksheets("Test Results").Cells(9, 2)
channel = temp.Worksheets("Test Results").Cells(10, 2)
range = temp.Worksheets("Test Results").Cells(11, 2)
sensor_sn = temp.Worksheets("Test Results").Cells(12, 2)
accuracy = temp.Worksheets("Test Results").Cells(13, 2)
sensor_offset = temp.Worksheets("Test Results").Cells(14, 2)
sample_rate = temp.Worksheets("Test Results").Cells(15, 2)
data_points = temp.Worksheets("Test Results").Cells(16, 2)
start_time = temp.Worksheets("Test Results").Cells(17, 2)
max_pressure = temp.Worksheets("Test Results").Cells(18, 2)
reference_pressure = temp.Worksheets("Test Results").Cells(19, 2)
time_above_ref = temp.Worksheets("Test Results").Cells(20, 2)
test_status = temp.Worksheets("Test Results").Cells(21, 2)
number_shear_pins = temp.Worksheets("Test Results").Cells(22, 2)
comments = temp.Worksheets("Test Results").Cells(29, 2)

ReDim data_A(0 To data_points) As Integer
    
temp.Activate

    max = 0
    For count = 0 To (data_points - 1)
        data_A(count) = temp.Worksheets("Test Results").Cells(30 + count, 1)
        If data_A(count) > max Then
        max = data_A(count)
        End If
    Next count

'close workbook and do not save changes
ActiveWorkbook.Close SaveChanges:=False

now when i hit run/debug i get a run-time error '424': Object required

on either the line that starts with test_type or location.

how do i fix this error?

I am looking to write a macro that will save the file (1.xls) in a
specific directory when running. The Macro works well, but if I open an
other file (2.xls) in other Directory, my Macro saves the file in that
Directory.
Here is an example of my Macros:
Sub OK_sttt()
'
' INREG stttV LIST Macro
' Macro recorded 20.03.2006 by emil
'
Workbooks.Open Filename:="E:SERVIMlivrari dupa inventarStoc timp
real.xls"
Windows("Stoc timp real.xls").Activate
Rows("2:15").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 18
Windows("sttt.xls").Activate
Range("D13:D26").Select
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("K2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("I13:I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.SmallScroll ToRight:=41
Range("AV2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("J13:J26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.SmallScroll ToRight:=-25
Range("AB2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("M13:M26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.Panes(3).Activate
Range("A2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("E6:I6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("B2:B15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("sttt.xls").Activate
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("J2:J15").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("E2:E15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("sttt.xls").Activate
Range("J13:J26").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Workbooks.Open Filename:= _
"E:SERVIMLivrari dupa inventarFISIER Save As BL.xls"
Windows("sttt.xls").Activate
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
Range("A2").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
Range("B2").Select
Selection.Copy
Windows("sttt.xls").Activate
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ChDir "F:Livrari dupa inventarprobe1.05.06"
sFilename = Format(Worksheets("Sheet1").Range("g4").Value, "@")
ans = MsgBox("Save file as " & sFilename)
If ans = vbOK Then

ActiveWorkbook.SaveAs Filename:=sFilename
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=2, Collate _
:=True
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
ActiveWorkbook.Close
Workbooks.Open Filename:="E:SERVIMlivrari dupa inventarsttt.xls"
Windows("sttt.xls").Activate
ActiveWindow.WindowState = xlMaximized
Range("G4").Select
ActiveCell.FormulaR1C1 = ""
Range("D13:J26").Select
Selection.ClearContents
Range("M13:M26").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-8
Range("E6:I6").Select
ActiveCell.FormulaR1C1 = ""
Range("E6:I6").Select
Range("L1").Select
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
ActiveWorkbook.Save
End If
End Sub
Thanks for any help
Emil

I have a macro I want to run every time I open *any* Excel file. It
searches across all worksheets and replaces NOW() with a constant. I
saved it in my personal.xls file as Auto_Open, but when I open any file
nothing happens. (this is where I get confused)

If I then manually open my personal.xls file the macro instantly runs
on my currently open file.

How can I make it run on any file I open in my Excel without manually
opening personal.xls...

I have a macro that runs automatically when the workbook is opened. If the
workbook is *not* opened in read-only mode, and I am the user, the macro
should unprotect the worksheet and msgbox that the worksheet has been
unprotected.

For some reason, the msgbox always appears twice when I am opening the
workbook in read/write mode. However, if I run the macro a second time when
the workbook is already open, the msgbox appears just once. Any idea why
this happens?

Thanks.

----------------------
Private Sub Workbook_Open()
Call Auto_Open
End Sub
----------------------
Sub Auto_Open()
Dim User As String
Dim R_O_Status As Boolean
R_O_Status = Workbooks("Book1").ReadOnly
User = Environ("UserName")
If R_O_Status = False Then
Select Case User
Case "Noah"
ActiveSheet.Unprotect Password:="Password"
MsgBox "Worksheet is unprotected."
Case Else
MsgBox "Worksheet remains protected."
Exit Sub
End Select
Else: MsgBox "You are in read-only mode."
End If
End Sub

Hello everyone:

I am trying to create a spreadsheet to calculate thermodynamic
properties of a steam turbine and am having a number of problems with
Excel. I have been making changes to it over the last couple of months
and gotten myself into a bind. Just when I think I have everything
nailed down and working.... something else craps out. I will try to
explain, as best I can, what has happened (or not happened) in the last
week.

I have a spreadsheet, you can download it from here
http://www.csupomona.edu/~cthompson1...chores-BAD.xls
that keeps aborting with an invalid page fault.

I have been saving backup copies for each of my major changes and
think I have located the problem here between these two backup
versions:
http://www.csupomona.edu/~cthompson1...ies-bu-008.xls
and
http://www.csupomona.edu/~cthompson1...ies-bu-009.xls
.. They both have calculations under the toolbar->options set to
automatic and the iterations checked. The "009" spreadsheet immediately
starts executing the spreadsheet formulas as soon as it is opened, the
"008" version does not. Apparently I didn't notice this until around
version "010" when I started making changes to the debug routines in my
code.

The first thing I did was to add code like the following to identify
the calling cell that caused my visual basic functions to fail:

Public Function TempDPW(Density, Pressure, Optional Guess, Optional
Precision, Optional iterations)

Dim myName As String
Dim myCell As Range
Dim mySheet As Worksheet
Dim myBook As Workbook
Dim aName As Name
Dim CellName As String

If IsError(Density) Or IsError(Pressure) Or IsEmpty(Density) Or
IsEmpty(Pressure) Or Density <= 0 Or Pressure <= 0 Then Exit Function

On Error Resume Next

myName = "TempDPW"

If TypeName(Application.Caller) = "Range" Then
Set myCell = Application.Caller
Set mySheet = myCell.Worksheet
Set myBook = mySheet.Parent
Err.Number = 0
For Each Name In myCell
Set aName = myCell.Name
If Err.Number = 0 Then
CellName = aName.Name
Else
CellName = "#N/A"
End If
Err.Number = 0
Next Name
End If

On Error GoTo Error_routine

....

TempDPW = T

Exit Function

Error_routine:
Debug.Print myName, "Density=", Density, "Pressure=", Pressure
If (TypeName(myCell) = "Range") Then Debug.Print myName, "Sheet=",
mySheet.Name, "Name=", CellName, "Row=", myCell.Row, "Col=",
myCell.Column, "Address=", myCell.Address
Debug.Print myName, "Error Source=", Err.Source, "Num=", Err.Number,
"Line=", lnum, "Desc=", Err.Description
Stop
Resume Next

End Function

After these changes I discovered that I could stop the spreadsheet
("009") from calculating on startup if I set Application.Calculation =
xlCalculationManual before I save it to disc. So I set up a button on
my standard tool bar to switch between automatic and manual, and added
code to turn off the automatic calculation "Before_Save" in my
workbook. The code follows:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

On Error Resume Next

Application.CommandBars("Standard").Controls("Calculation Mode").Delete

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

On Error Resume Next

Me.Application.CalculateBeforeSave = False
Me.Application.Calculation = xlCalculationManual
With Me.Application.CommandBars("Standard").Controls("Calculation
Mode")
.State = msoButtonDown
.TooltipText = "Calculation mode is manual"
End With

End Sub

Private Sub Workbook_Open()

Dim cmd As CommandBarControl

On Error Resume Next

'Debug.Print "Workbook_open is here!"

initialize

With Application.CommandBars("Standard")

Err.Clear

Set cmd = .Controls("Calculation Mode")
If Err.Number <> 0 Then Set cmd = .Controls.Add

With cmd
If Application.Calculation = xlCalculationAutomatic Then
.State = msoButtonUp
.TooltipText = "Calculation mode is Automatic"
Else
.State = msoButtonDown
.TooltipText = "Calculation mode is manual"
End If
.BeginGroup = True
.Caption = "Calculation Mode"
.OnAction = "CalcMode"
.FaceId = 2
End With
End With

'Debug.Print "Workbook_Open Is not here!"

End Sub

The way the spreadsheet works in the "008" version it this.
Immediately after the workbook is opened, I run the macro "initialize"
to initialize the water module constants and arrays. Then I can make
changes to the spreadsheet, and run the macro "AllGoalSeek" to update
the cells and do the spreadsheet calculations. It seems like the "F9"
button does nothing here, but <ctl-alt-F9> recalculates all of the
cells.

In the "009" version I was stumped when I opened the workbook and
started running into my debug code "Stop" statements. I finally
realized that none of the constants or arrays had been initialized, and
I started working the problem of turning off the calculation mode at
startup. The first thing I did here was to install "Workbook_Open" code
to execute the "Initialize" subroutine and set the module constants and
arrays. This code was unfortunately never executed and i have no idea
why. I put a "stop" statement on the first line of "Workbook_Open" and
discovered to my horror that it never popped up. So then I added an
"auto_open" macro to my water module with the initialization code
inside, only to discover to my further horror that this was never
executed until AFTER ALL of the cells had calculated their functions in
ERROR with the module UN-initialized. I think "F9" works ok here, but
<Ctl-alt-F9> does nothing. I don't get it!

Where I am at now is this: The "BAD" spreadsheet kinda works and
kinda doesn't work. Before this one I added some new routines
"EnthalpySPW, TempSPW, TempHPW" which do the same thing as GoalSeek in
a function. These seemed to be working ok for the most part until I
found out that Excel sent parameters in error. I added checks to exit
the functions when this occured and thought that all of my problems
were solved and got rid of my "AllGoalSeek" macro. Then I added code
"TempDPW" and screwed everything up. Somehow when I did a search and
replace on temperature and density, and I inadvertantly changed
everything in the module instead of just the highlighted code in the
TempDPW function. So I deleted the module and brought in a fresh "OLD"
copy from the previous spreadsheet. The problem still seems to exist
where a page fault can occur anywhere at anytime... Usually before I
have a chance to save my changes.

What I have noticed today is that my "Calculation Mode" button
doesn't appear to be working. I was pressing the button on the
spreadsheet and noticed that it was NOT changing state. It always
stayed down in "Manual" mode even if the Toolbar->Options->Calculation
said that the spreadsheet was in "Automatic" mode. When I put in a
break into my CalcMode macro to see what was going on, I found that it
got to the line Application.Calculation = xlCalculationAutomatic and as
soon as the line executed, the spreadsheet started calculating cells.
This time though the constants and arrays are initialized and so
everything should run ok. Except that somewhere in the spreadsheet an
EnthalpyW function is called with the temperature in an "ERROR 1021"
state or something. The function sees the error and exits the function
with the "Exit Function" statement and that's it. Nothing else happens
and the code never returns to the CalcMode macro to finish with the
button setup.

If anybody has any ideas how to do a better job with this thing
please post to this group. I am at my wits end on this one.

P.S. Is there any way to tell Excel what order I want it to executed
cells in? Sometimes it looks like it is calculating everything, other
times only a couple of cells. With Iterations turned on, I see a kind
of ripple effect through the cells. The wierd part is when it stops and
in cells where "if statements" check conditions, the results of the "if
statements" don't match the conditions reported in the spreadsheet. Is
there some way I can tell Excel to do everything from this cell to
another cell just one time?

Oh yeah. The other thing that is bugging me is when I open the
spreadsheet and it ask's me if I want to "Enable" or "Disable" macros
and I say "Disable," the next thing I get is a dialog about "Excel type
4.0 macros." If I say "no" the workbook doesn't open, and if I say
"yes" it does. As far as I know I only have Visual Basic type macros.
Are these the "Type 4.0" macros, or do I have a virus or something that
I am unaware of?

Regards from,
Chris Thompson

Hello,
I need help with a macro. Here is a background to my macro and what it
does. I have an excel workbook that will have a worksheet with headers in
row 1. The user will enter data below the headers in row 1. A command
button will also be on this worksheet. When the command button is pressed,
it will take all the data and output a .csv file to a particular location.
Here is the code for this:

Public Sub CreateCSV()
Dim iFile As Integer
Dim lRow As Long
Dim iCol As Integer
Dim sDelimiter As String
Dim sSpace As String
Dim sOutput As String

sDelimiter = ","
sSpace = " "

'Open the file for write
iFile = FreeFile
Open "C:OUTPUT_FILE" & ActiveSheet.Name & ".csv" For Output As #iFile

'parse the rows and columns
For lRow = 2 To ActiveSheet.UsedRange.Rows.Count
sOutput = ""
For iCol = 1 To ActiveSheet.UsedRange.Columns.Count

'build output string
If Cells(lRow, iCol) = "" Then
sOutput = sOutput & sSpace & sDelimiter
Else
sOutput = sOutput & Cells(lRow, iCol) & sDelimiter
End If
Next iCol

'write the output string to the file
sOutput = Left(sOutput, Len(sOutput) - 1)
Print #iFile, sOutput
Next lRow
Close #iFile

MsgBox "The .csv file is now located in the following folder -
C:OUTPUT_FILE", vbInformation, "Upload Data"

End Sub

I am an accounting guy and don't have a lot of VB knowledge, most of this
code was not written by me. Here are the two problems I have with the macro:

1. How do I get this macro code to run when the command button on the
worksheet is clicked?

2. This workbook will be used by multiple users and not all users have the
folder "C:OUTPUT_FILE" in their C drive yet. How can I check to see if
this folder exists - if it does output the file - if it doesn't, create the
folder and then output the file?

Please help!!! Thanks!!!!

Ryan

I'm creating spreadsheets that contain buttons/macros to filter for
specific criteria. I want all records/rows to be shown when the
workbook is opened. I have 2 macros to accomplish this. One is attached
to a button which appears on every worksheet to remove any filters.

Sub ShowAll()
'
' ShowAll Macro
' Macro recorded 3/11/2005 by Dave Bellamy

Range("a1:J62").AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Range("S5:Z6"), Unique:=False
Range("c4").Select

End Sub

I used blank filter criteria instead of other methods that I found to
remove filters because none of the others worked in a protected sheet.

The second macro goes through all sheets in the workbook and removes
all filters automatically on opening. Or it should. It calls the first
program to do so. I've stepped through the macro, and it goes to both
sheets (I'm testing with 2 sheets, more will come later so I want the
macro to run on however many sheets there are in the workbook). But it
doesn't remove the filter in the second sheet.

Sub Auto_Open()
Dim Wks As Object
For Each Wks In ThisWorkbook.Worksheets
On Error Resume Next
ShowAll
Next Wks
End Sub

Does anyone know what's wrong?

Hi

I'm very new at Access, so would appreciate any help anyone can give me.

I have data in an Access table that I want to export to an Excelfile. I can open up Access and do an manual export but it is not fast, and I have some probs, which I assume/hope can be easily solved:

1) the Access file is from another person, and is in Access97 format. So when I open it, I get all the queries about opening/converting, etc. (I am using Access 2003). I dn't knowe if this matters, but the Access files do not have the file name extension .mdb, the person who makes them uses .bam

2) When I export, the data comes through fine, but to a new worksheet that it creates with the same name as the Access table. Can I export it ot an existing worksheet in my excel file?

3) Can I do all this using a macro that runs out of my excel file?

Thanks again for any help

Cheers
free

I have created an invoice that I want to email to a company. I have the
invoice worksheet formatted so that the entire invoice is visable and fills
the entire width of my screen at 100% Zoom Magnification. It occured to me
that if the company has a screen resolution different from mine, the entire
invoice will not fill the screen. I discovered this when I changed my own
screen resolution.
I thought the solution to this problem would be to simply highlight the area
I wanted to fill the screen and then set the View Zoom Magnification to Fit
Selection. After I did that, I then changed my screen resolution to a lower
setting. Unfortunately, the Fit Selection Setting didn't hold. It reverted
back to 100% Zoom Magnification and my invoice was now partially off screen.
I'm thinking the solution may need to be a macro that runs when the document
is openned that will select the area of the invoice and then change the Zoom
Magnification to Fit Selection, but does anyone knows of simpler way?

I am using Excel 2007 to create my own cfl stats sheet. I want it to automatically update stats information from a website.

The problem I'm running into is that if there are more than fifty players in a single statistic range then the website has a scroll button to scroll between pages, but the URL address stays the same.

I have tried using two web connections (one for each page) but since the URL is the same it only returns the first page of stats. I've also tried recording a macro that opened a hyperlink and copied the first page and then the second, but when I run it it just pastes the second page into my worksheet twice.

I would like the info to stack up like a single running table. The link for the stats I am talking about is http://www.sportsnet.ca/football/cfl...ing&sort=yards

If someone knows how I can achive this it would be greatly appreciated. I don't care if the column labels from the top of the table on the website are imported or not, as long as the statistics update from the website.

I have a workbook that, when opened, generates the usual dialogue box about
updating automatic links to other workbooks. When I go to Edit/Links, 2
source files are shown.

How do I find the cells in which these links are contained? I have tried
searching each worksheet using "!" in formulas. I want to delete the links.

I have a workbook called findlink.xla which I have obviously downloaded at
some stage. When I open this (with the other workbook open) I get the usual
message about Macros but then nothing further happens. No Macro is then
available to run.

What am I doing wrong?!

Many thanks.

I have a userform with two list boxes. The first listbox pulls column headings from a worksheet and displays them. I have Add and Delete buttons so that the user can put desired data in the second listbox. From the second listbox I need to access the data in the columns whose headings are in the listbox so that I can plot the data. For example, if I have A, B, C, D, and E in ListBox1, and the user wants to plot the data for C and D only, then C and D would show up in ListBox2. See the attached spreadsheet for an example of what I am working with. In this example, I read in the column headings starting at Column B (the main data/Y axis data). When the user chooses which values to plot, I need to be able to access that data and use the values in Column A as my X axis values. As a side note, the currents and voltages need to have separate Y axes. You will have to open the macro to run the example. I mainly need to know how to get back to the data in the columns just by knowing the column heading/location of the items in ListBox2. Thanks in advance for your help!

Many years ago (pre-Excel 4.0) I created a spreadsheet that uses a few custom function macros to perform pipe flow analysis calculations. Over the years, as I have upgraded to newer versions of Excel and the spreadsheet opens and runs without any errors. I do get an error message when I try to save (warning about Excel 4.0 macros). I'm trying to figure out how to use these functions in another spreadsheet, but I am struggling.

The only visible reference to any of the functions is either through the User Defined section of the Insert Function menu or as a "Refers To" entry in the Name Manager. Here's how one of them looks in the spreadsheet cell.

=Manning_macro!Capacity($C$7,$C$5,$D$5)*1.55

I cannot find any reference to "Manning_macro" in the worksheet, at all.

1. How do I access and edit these functions?

2. How do I use them in other spreadsheets?

Thanks for looking.
Rick

I am struggling to complete a project with a client; unfortunately he's in Japan whilst I'm in the UK, so we're working remotely.

The code I've written asks for a folder to be selected; it then takes all .csv files that are within that folder, copies the data contained, carries out formatting and saves off each worksheet as a new workbook.

Everything works fine on my computer (PC running Excel 2010).

My client is having variable results. We've traced this to an issue in the "find .csv files" portion of the code.

In an attempt to understand the issue, I modified the code being used to find / cycle through files in order to simply provide a list of files within the folder - in order that he could return this to me and I would at least be able to see what filenames / extensions were present in the folder.

However, it now transpires that when he uses this trial code, regardless of which folder he selects in the "open folder" dialogue, the macro shows the contents of his Desktop folder.

Anyone able to solve my headache and suggest what's going on?!

Code used is as follows:

Sub ListMyFiles()
    
Dim MyFolderName As String
Dim MyFileName As String
Dim iCol, iRow As Integer

Application.FileDialog(msoFileDialogFolderPicker).Show
MyFolderName = CurDir
If Right(MyFolderName, 1) <> "" Then
    MyFolderName = MyFolderName & ""
End If

Set MyObject = CreateObject("Scripting.FileSystemObject")
Set mySource = MyObject.GetFolder(MyFolderName)

On Error Resume Next

Range("C2").Value = MyFolderName

iRow = 5

For Each myFile In mySource.Files
    iCol = 2
    Cells(iRow, iCol).Value = myFile.Path
    iCol = iCol + 1
    Cells(iRow, iCol).Value = myFile.Name
    iCol = iCol + 1
    Cells(iRow, iCol).Value = myFile.Size
    iCol = iCol + 1
    Cells(iRow, iCol).Value = myFile.DateLastModified
    iRow = iRow + 1
Next
End Sub
This is modded code from ExcelExperts.com - http://www.excelexperts.com/VBA-Tips...es-In-A-Folder.

I have a requirement for query with parameters to get data from MS SQL 2005 db. Apparently, one cannot use the OLEDB driver and the Connection Properties box, so I'm writing a macro to collect the parameters from Sheet2 and output data to Sheet1.
When Sheet1 is blank, the following works like a charm. Once the data has been retrieved though, the consequent executions of the macro just add columns with data.

Before having added the qt.Delete statement, I had a condition of trying to refresh the qt, which didn't work, so I guess the only means to refresh the data is to re-create the qt every time the macro runs, which seems extremely inefficient.

So I guess I'd like to find out answers to the following questions:
1) Is there a way to actually refresh a QueryTable that was based on a recordset by changing the recordset and just perform the .Refresh method (without constantly doing the .Add)?
2) If not, what's the best mechanism of doing the "refresh"?

Thank you,
Sergey

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim stSQL As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rn As Range
    Dim qt As QueryTable
     
    Const stADO As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
    "Persist Security Info=False;" & _
    "Initial Catalog=SiriusSQL;" & _
    "Data Source=SRV-MTC-SIRIUS"
     
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(1)
     
    With ws
        Set rn = .Range("A1")
    End With
     
    stSQL = "<some SQL statement>"
     
    Set cn = New ADODB.Connection
     
    With cn
        .CursorLocation = adUseClient
        .Open stADO
        .CommandTimeout = 0
        Set rs = .Execute(stSQL)
    End With
     
    Set qt = ws.QueryTables.Add(Connection:=rs, Destination:=rn)
    With qt
        .RefreshStyle = xlInsertDeleteCells
        .Refresh False
        .MaintainConnection = False
        .Delete
    End With

     'Cleaning up.
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing


I have a logsheet that i wanto be able to see what time certain cells were updated,

in column a row 1 i enter the phone number of a client, i want column b row 1 should enter the current time and the time should stay there (and not be updated when b2 or b3 were updated)

also is there a way to store a autorun macro only in 1 workbook??
i have multiple workbooks open and in the logsheet i have a autorun macro that runs every 5 seconds which saves the log so that no data gets mistakenly erased, but if im currently working on another worksheet (order form) the macro tries running in the open worksheet and it spits an error saying something like: cant save file cuz u havto save it as a macro enabled workbook, but i dont wanto really save the order form i wanto save the logsheet.

any advice??