Free Microsoft Excel 2013 Quick Reference

Form function to save worksheet Results

Is there something I can program into my form so that when a record is added and the 'add' button is clicked, it not only adds the record to the work sheet but saves the workbook as well.

Thank you

I want to Save-as a file from within a macro, taking the new name from the
worksheet's cell contents. I want to save an order form with a file name
based on the order number contained in a worksheet cell. My question is how
to get the cell contents into the Save-as dialog box when the macro calls the
Save-as function.
Thanks.

In Excel 2000 I used the Template Wizard to copy form data to a spreadsheet
table in another workbook. I don't see this function in Excel 2003.

I narrowed down my problem in using the form with a new workbook.
If I use the add button to add a value, it will always put the value in row 5.
If I click the next button, then the add button, the next value will be put on row 6 and so on.
How can I fix this problem so the user can add a value without going to the next row?

It had to do with UsedRange .Rows.Count?

I have a worksheet called sheet1 that receives data through the user
form with the following codes:

'Since we will be allowing the user to move up and down the list,
'weâ?Tll need a way to keep track of which row number the form is
'currently displaying.
'We will do this by creating a "form level" variable.
Dim CurrentRow As Long

Private Sub cmdAdd_Click()
'Save form contents before changing rows
SaveRow
' Set current row to first empty row, i.e. one row after
' the last row currently in use:
If Sheet1.Cells(5, 1).Value = "" Then
CurrentRow = 5 ' (list is empty - start in row 5
Else
CurrentRow = Sheet1.UsedRange.Rows.Count + 1
End If
' Clear the form for user to add new name:
Call LoadRow
' Set focus to Name textbox:
txtCowID.SetFocus
End Sub

Private Sub cmdClose_Click()
'Save form contents before changing rows:
SaveRow
Unload Me ' Close the form
End Sub

Private Sub cmdDelete_Click()
Dim smessage As String
smessage = "Are you sure you want to delete Cow" + txtCowID.Text + "?"
If MsgBox(smessage, vbQuestion + vbYesNo, _
"Confirm Delete") = vbYes Then
' Delete current row:
Sheet1.Rows(CurrentRow).Delete
' Show contents of new current row in the form:
LoadRow
End If

End Sub

Private Sub cmdNext_Click()
'Save form contents before changing rows:
Call SaveRow
' Increment row number:
CurrentRow = CurrentRow + 1
'Show contents of new row in the form:
LoadRow
End Sub

Private Sub cmdPrevious_Click()
' Show previous only if not already in first row:
If CurrentRow > 5 Then
'Save form contents before changing rows:
SaveRow

' Decrement row number:
CurrentRow = CurrentRow - 1

' Show contents of new row in the form:
LoadRow
End If
End Sub

Private Sub UserForm_Activate()
' Read initial values from Row 5:
CurrentRow = 5
LoadRow
End Sub
'function to call values
Private Sub LoadRow()
txtCowID.Text = Sheet1.Cells(CurrentRow, 1).Value
txtEnrollDate.Text = Sheet1.Cells(CurrentRow, 2).Value
txt1AIDate.Text = Sheet1.Cells(CurrentRow, 3).Value
txt2AIDate.Text = Sheet1.Cells(CurrentRow, 4).Value
txt3AIDate.Text = Sheet1.Cells(CurrentRow, 5).Value
txt4AIDate.Text = Sheet1.Cells(CurrentRow, 6).Value
txt5AIDate.Text = Sheet1.Cells(CurrentRow, 7).Value
End Sub
'function to save values
Private Sub SaveRow()
Sheet1.Cells(CurrentRow, 1).Value = txtCowID.Text
Sheet1.Cells(CurrentRow, 2).Value = txtEnrollDate.Text
Sheet1.Cells(CurrentRow, 3).Value = txt1AIDate.Text
Sheet1.Cells(CurrentRow, 4).Value = txt2AIDate.Text
Sheet1.Cells(CurrentRow, 5).Value = txt3AIDate.Text
Sheet1.Cells(CurrentRow, 6).Value = txt4AIDate.Text
Sheet1.Cells(CurrentRow, 7).Value = txt5AIDate.Text

End Sub

Everything works except the add button. I would appreciate if you
could look the code over and help me.
I am new at VBA.
Thank you very much

The scenario: Several co-workers trying to access the same worksheet to enter
details and retrieve a reference. I think I need a standalone form that takes
the details and minimises the time trying to save the data and return a
reference - i.e. write access is kept to a minimum time frame. Otherwise lots
of waiting whilst updating, even if copy and pasting.

E.g. Simple form with required fields. If attempt at save is successful then
a reference is returned, else retries until so.

Any advice appreciated, as I really need to make the time savings. I'm sure
it's been done a dozen times already so if you know of a place I can find
it...?

Cheers.

I have an user form with combo lists that enter data into a worksheet called EnterCowData. It is working fine except the command button cmdEnterData_Click(), only the first value ( CowListStart.Offset(j, 8).Value = TxtAIPregDate.Text) is entered on the worksheet, not the other two. I cannot figure out what is wrong. If I change the order the first one is the one recognized. Please could you help me?

Option Explicit
Dim FirstAIDate As Variant
Dim SecondAIDate As Variant
Dim ThirdAIDate As Variant
Dim CmyLastRow As Variant
Dim CmyLastARow As Variant
Dim CmyRange As Variant
Dim CowId As Integer
Dim CowListStart As Variant
Dim i, j As Integer
Dim CowStart As Range
Dim p As Integer
Dim AIPregRange As String
Dim PregRange As String
Dim PalpPregRange As String
Dim BreedRange As String

Private Sub UserForm_initialize()

'pregnant yes or no
cboPregnancyTest.List = Array("Yes", "No")

'List of breedings
cboBreedingNo.List = Array(1, 2, 3, 4, 5)

' I would like to have all the rows read
'for combo box

FirstAIDate = txt1AIDate.Value
SecondAIDate = txt2AIDate.Value
ThirdAIDate = txt3AIDate.Value

Worksheets("EnterCowData").Activate

CmyLastRow = LastCell(Worksheets("EnterCowData")).Address
CmyRange = "A3:" & CmyLastRow

'sort the range by CowID
Range(CmyRange).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Worksheets("EnterCowData").Range(CmyRange).Name = "Options"
cboCowList.RowSource = "Options"
cboCowList.BoundColumn = 1
cboCowList.ColumnCount = 1

Application.ScreenUpdating = True

End Sub

Private Sub cboCowList_Click()

Worksheets("EnterCowData").Activate
CmyLastARow = LastCell(Worksheets("EnterCowData")).Row
CmyRange = "A3: A" & CmyLastARow
Set CowListStart = Worksheets("EnterCowData").Range("A3")
CowId = cboCowList.Value
i = 0
Do Until i = CmyLastARow + 1
If CowListStart.Offset(i, 0).Value = CowId Then
LoadRow

j = i

End If
i = i + 1
Loop

End Sub

'function to call values
Private Sub LoadRow()
txt1AIDate.Text = CowListStart.Offset(i, 3).Value
txt2AIDate.Text = CowListStart.Offset(i, 4).Value
txt3AIDate.Text = CowListStart.Offset(i, 5).Value
txt4AIDate.Text = CowListStart.Offset(i, 6).Value
txt5AIDate.Text = CowListStart.Offset(i, 7).Value
TxtAIPregDate.Text = CowListStart.Offset(i, 8).Value
TxtPregDate.Text = CowListStart.Offset(i, 9).Value
cboPregnancyTest.Text = CowListStart.Offset(i, 10).Value
cboBreedingNo.Text = CowListStart.Offset(i, 11).Value
End Sub

Private Sub cmdEnterData_Click()

Call SaveRow

' Set focus to Name textbox:
cboCowList.SetFocus
End Sub

'function to save values
Private Sub SaveRow()
CowListStart.Offset(j, 8).Value = TxtAIPregDate.Text
CowListStart.Offset(j, 9).Value = TxtPregDate.Text
CowListStart.Offset(j, 10).Value = cboPregnancyTest.Text
CowListStart.Offset(j, 11).Value = cboBreedingNo.Text
End Sub

Private Sub cmdClose_Click()
'Save form contents before changing rows:
Unload Me ' Close the form
Call ClearDatabase
Call FunctionDatabase
Call AIDates 'fill AI Dates on EnterCowData sheet
End Sub

Thank you

I have a multipage workbook and I need to setup a macro to save "sheet 3" as
a seperate .prn file. I've tried using the SaveAs macro function with .prn
at the end of the file name but it still saves it in Excel form.

I apologizing for reposting of this question because it only shows me printable view and I can't delete the thread.
http://www.excelforum.com/excel-prog...int-print.html
It happens to be the word "Print" appears in my title.

Here is the details of my question
I want create 2 button (form control) to perform save and print.
I wish to perform a "Save As.." function to save a specific single sheet from my workbook. So everytime I open the saved file it only appears a single sheet only. How should I write the macro and assign to the button? (Allow me to ask 1 more question, if the page I save contains formula and graph in which the data are taken from the other worksheets, will the formula and graph in new saved file shown invalid reference as I only save a single sheet from it?)
On the other hand, I have set the print area of the workbook. How to I assign another macro to another button so it will only print out the area which I set as print area?

Thanks in advance.

BRIEF
Hiding form button and showing warning message shape works in most Excel versions, but the button doesn't actually "hide" in 2007 in my application (but seems to work as expected in a mock up).

In the following figure...
xl07-form-buttons-not-hiding.jpg

A) The state after opening, and macros are enabled
B) Incorrect state after save (Excel 2007 only), buttons still visible
C) Correct state after save, buttons are not visible and warning message is

Sending front/behind has yielded no positive results, also recreated buttons and warning shape in Excel 07 (in case it was due to artifacts from being authored in 2010)

BACKGROUND
I have an Excel application that I developed in 2010 which uses a formatted worksheet to gather user input.

I've found the resources that help with ensuring (as best as reasonably possible) that a user enables macros in order to correctly use the application. My application starts with a red rounded corner rectangle that covers my two form buttons (which should have their visibility set to False upon save/open). I've implemented the before close/save routines to ensure that this functionality is implemented (and is present upon every open, until macros are enabled, in which case the warning's visibility is set to false and the two form buttons have their visibility set to true.

This is working brilliantly with Excel versions 2001/XP through 2010. However, with 2007, the code is executed to hide the two form buttons and set the warning to visible, and I've verified this by setting a breakpoint after and checking their values in the immediate window... but they're still showing (after execution, and upon reopening)!

I read elsewhere where someone found that in Excel 2007 specifically, their "shapes" would no longer appear above their form controls, no matter what they did and thought this was perhaps a related bug. So, I mocked up the functionality in a new workbook and all seems to work as expected (if you create a sheet, shape, and optional image... overlapping at various places so it is possible to see a portion of all of them at once if you choose)...


	VB:
	
Option Explicit 
 
Dim w As Worksheet 
Dim s As Shape 
Dim b As Shape 
Dim i As Shape 
 
 
Public Sub OnOpen() ' called from workbook_open
    Set w = ActiveSheet 
    Set s = w.Shapes("MyShape") 
    Set b = w.Shapes("MyButton") 
    Set i = w.Shapes("MyImage") 
     
    MsgBox "Opened" 
End Sub 
 
 
Sub shapeBtn_Click() 
    Call screenFirstOff 
    s.Visible = Not s.Visible 
    Call screenFirstOn 
End Sub 
 
Sub buttonBtn_Click() 
    Call screenFirstOff 
    b.Visible = Not b.Visible 
    Call screenFirstOn 
End Sub 
 
Sub imageBtn_Click() 
    Call screenFirstOff 
    i.Visible = Not i.Visible 
    Call screenFirstOn 
End Sub 
 
 
Sub screenFirstOff() 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
End Sub 
 
Sub screenFirstOn() 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 
 
 
Sub eventFirstOff() 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
End Sub 
 
Sub eventFirstOn() 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
In 2007, via this mock up, it does just what I would expect (when I hide one, the one beneath is shown completely). Saving the document, and opening it again, and the same object is still hidden.

I thought that perhaps my problems were related to the order of event/screenupdating being disabled and enabled just prior to the before save/close events (and actual save) occurring and was toying with them.

I guess to an extent, this doesn't completely replicate my actual application (as it doesn't handle before save/close, and only one shape changes at a time)... but it seems to illustrate what I want to accomplish.

Apologies for the long post, just hoping to save time by explaining what I've tried thus far. What would all of you like me to include to help troubleshoot... I was thinking of including video somewhere.

Has anyone encountered this? Googling (in general, as well as searching this forum and others) haven't turned up anything yet (aside from the ordering issue, in contrast to hiding at all).

My (cleansed) code...

	VB:
	
 
 
 
Const INPUT_FIELD_SUBJECT As String = "Selected_Subject" 
Const INPUT_FIELD_STATUS_TERM As String = "Selected_Status_Term" 
Const INPUT_FIELD_GROWTH_TERM As String = "Selected_Growth_Term" 
 
Const INTERFACE_SHEET As String = "Calculator" 
Const DATA_SHEET_STATUS As String = "Status Parms" 
Const DATA_SHEET_GROWTH As String = "Growth Parms" 
Const DATA_TABLE_GROWTH As String = "GrowthTable" 
Const DATA_TABLE_STATUS As String = "StatusTable" 
Const DATA_TABLE_CALCULATOR As String = "Calculator_Table" 
Const STATUS_CELL As String = "Status" 
 
Const GROWTH_OUTCOME_GAIN As String = "Gain" 
Const GROWTH_OUTCOME_CGI As String = "CGI" 
 
Private Const PROTECTION_INTERFACE As String = "password" 
Private Const PROTECTION_NONINTERFACE As String = "password" 
Private Const UNLOCK_CELL As String = "$A$1" 
Private Const UNLOCK_CODE As String = "CODE" 
Const COLOR_LIGHT_RED As Long = 9737946 'RGB(218, 150, 148)
Const COLOR_LIGHT_GREEN As Long = 12379352 'RGB(216, 228, 188)
Const COLOR_WHITE As Long = 16777215 ' RGB(255, 255, 255)
 
Const STATUS_MESSAGE_SHORT_FONTSIZE As Integer = 24 
Const STATUS_MESSAGE_SHORT_MAXCHARS As Integer = 60 
Const STATUS_MESSAGE_FONTSIZE As Integer = 12 
Const STATUS_MESSAGE_MAXCHARS As Integer = 240 
 
Dim CalculatorTable As Range 
Enum CalculatorTableFields 
    GradeLabel = 1 ' the rest are incremented from this value
    StatusInstructionalWeekStartDelta 
    StatusGradeMeanRitScore 
    StatusSchoolPercentile 
    GrowthObservedGradeMean 
    GrowthGradeMeanRitScoreForStartTerm 
    GrowthInstructionalWeekStart 
    GrowthInstructionalWeekEnd 
    GrowthMeanGainPercentile 
    GrowthPercentMeetingProjection 
    GrowthPercentMeetingProjectionPercentile 
End Enum 
 
Dim SelectedSubject As String 
Dim SelectedStatusTerm As String 
Dim SelectedGrowthTerm As String 
 
Dim DoContinue As Boolean 
 
 
Public Sub OnWorkbookOpen() 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
     
    Call protectWorkbook(False) 
     
    Worksheets(INTERFACE_SHEET).Activate 
    With Range(STATUS_CELL) 
        .Value = "" 
        .Interior.Color = COLOR_WHITE 
    End With 
     
    Dim calcButton As Shape 
    Set calcButton = ActiveSheet.Shapes("CalculateButton") 
    calcButton.Visible = True 
     
    Dim resetButton As Shape 
    Set resetButton = ActiveSheet.Shapes("ResetButton") 
    resetButton.Visible = True 
     
    Dim macroMessage As Shape 
    Set macroMessage = ActiveSheet.Shapes("MacroMessage") 
    macroMessage.Visible = False 
     
    Call protectWorkbook 
     
    ThisWorkbook.Saved = True 
     
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 
 
Public Sub CalculateButton_Click() 
    Call main 
End Sub 
 
Public Sub ResetButton_Click() 
    Call resetValues 
End Sub 
 
Private Sub resetValues() 
    Dim firstRowSecondColumn As Range, lastRowColumn As Range 
    Set CalculatorTable = Range(DATA_TABLE_CALCULATOR) 
    Set firstRowSecondColumn = CalculatorTable.Cells(1, 2) 
    Set lastRowColumn = CalculatorTable.Cells(CalculatorTable.Rows.Count, CalculatorTable.Columns.Count) 
     
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Call unlockInterface(True) 
     
    Range(firstRowSecondColumn, lastRowColumn).ClearContents 
    Range(INPUT_FIELD_SUBJECT).Select 
     
    Call updateStatus("Reset") 
     
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 
 
Private Sub main() 
    Application.EnableEvents = False 
     
    Call unlockInterface(True) 
    Call updateStatus("Calculating...") 
    Application.ScreenUpdating = False 
     
    Worksheets(INTERFACE_SHEET).Activate 
     
    DoContinue = True 
    Set CalculatorTable = Range(DATA_TABLE_CALCULATOR) 
    SelectedSubject = Range(INPUT_FIELD_SUBJECT).Value 
    If SelectedSubject  "" Then 
        SelectedStatusTerm = Range(INPUT_FIELD_STATUS_TERM).Value 
        If SelectedStatusTerm  "" Then 
            DoContinue = calcSchoolStatusMetrics() 
        End If 
         
        SelectedGrowthTerm = Range(INPUT_FIELD_GROWTH_TERM).Value 
        If SelectedGrowthTerm  "" Then 
            If DoContinue Then DoContinue = calcSchoolGrowthMetrics(GROWTH_OUTCOME_GAIN) 
            If DoContinue Then DoContinue = calcSchoolGrowthMetrics(GROWTH_OUTCOME_CGI) 
        End If 
    Else 
        updateStatus "Please ensure you've first selected the Subject and Terms desired.", True 
    End If 
     
    If DoContinue Then 
        updateStatus "Complete" 
    End If 
     
    Call unlockInterface(False) 
     
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 
 
Private Sub unlockInterface(doUnlock As Boolean) 
    Dim interface As Worksheet 
    Set interface = Worksheets(INTERFACE_SHEET) 
     
    If doUnlock = True Then 
        If interface.ProtectContents = True Then 
            interface.Unprotect Password:=PROTECTION_INTERFACE 
        End If 
    Else 
        If interface.ProtectContents = False Then 
            interface.Protect Password:=PROTECTION_INTERFACE 
        End If 
    End If 
End Sub 
 
Private Sub updateStatus(message As String, Optional isError As Boolean = False) 
    Dim status As Range 
    Set status = Range("Status") 
     
    Dim m As String 
    m = Trim(Left(message, STATUS_MESSAGE_MAXCHARS)) 
     
    status.Value = m 
     
    If Len(m) > STATUS_MESSAGE_SHORT_MAXCHARS Then 
        With status 
            .Font.Size = STATUS_MESSAGE_FONTSIZE 
            .HorizontalAlignment = xlLeft 
            .WrapText = True 
        End With 
    Else 
        With status 
            .Font.Size = STATUS_MESSAGE_SHORT_FONTSIZE 
            .HorizontalAlignment = xlCenter 
            .WrapText = False 
        End With 
    End If 
     
    If isError Then 
        status.Interior.Color = COLOR_LIGHT_RED 
    Else 
        status.Interior.Color = COLOR_LIGHT_GREEN 
    End If 
     
    status.Select 
    DoContinue = Not isError 
End Sub 
 
Private Function calcSchoolStatusMetrics() As Boolean 
     'DO SUPER SECRET STUFF
     
    calcSchoolStatusMetrics = True 
    Exit Function 
     
ErrHandler: 
    calcSchoolStatusMetrics = False 
    updateStatus "Error while calculating SECRET -- " & Err.Description, True 
End Function 
 
Private Function calcSchoolGrowthMetrics(outcomeCriteria As String) As Boolean 
     'DO SUPER SECRET STUFF
     
    calcSchoolGrowthMetrics = True 
    Exit Function 
     
ErrHandler: 
    calcSchoolGrowthMetrics = False 
     
    Dim errMsg As String 
    errMsg = "Error while calculating variable " 
    If outcomeCriteria = GROWTH_OUTCOME_GAIN Then 
        errMsg = errMsg & "SECRET (GAIN)" 
    Else 
        errMsg = errMsg & "SECRET (CGI)" 
    End If 
    errMsg = errMsg & " -- " & Err.Description 
     
    updateStatus errMsg, True 
End Function 
 
Private Function getRecordSet(fields As String, namedRange As String, where As String) As Recordset 
    Dim cn As ADODB.Connection 
    Set cn = New ADODB.Connection 
     
    Dim cnInfo As String 
    cnInfo = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ 
    ActiveWorkbook.FullName & _ 
    ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 
     
    Dim rs As ADODB.Recordset 
    Set rs = New ADODB.Recordset 
     
    Dim cm As ADODB.Command 
     
    Dim q As String 
    q = " SELECT TOP 1 " & _ 
    fields & _ 
    " FROM " & _ 
    namedRange & _ 
    " WHERE " & _ 
    where 
     
    On Error Goto ErrHandler 
     
    cn.Open cnInfo 
     
    Set cm = New ADODB.Command 
    With cm 
        .ActiveConnection = cn 
        .CommandText = q 
        .CommandType = adCmdText 
    End With 
     
    rs.Open cm.Execute 
     
    Set getRecordSet = rs 
    Goto CleanUp 
     
ErrHandler: 
    updateStatus Err.Description, True 
     
CleanUp: 
    Set cm = Nothing 
    Set rs = Nothing 
    Set cn = Nothing 
End Function 
 
Public Sub CheckForUnlock(ByRef target As Range) 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
     
    Dim unLockRange As Range 
    Set unLockRange = Range(UNLOCK_CELL) 
     
    Dim changed As Range 
    Set changed = target.Cells(1, 1) ' If multi-range edit, couldn't be unlock cell
     
    If changed = unLockRange Then 
        If UCase(changed.Value) = UNLOCK_CODE Then 
            Call protectWorkbook(False) 
        Else 
            Call protectWorkbook(True) 
        End If 
    End If 
     
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 
 
Public Sub OnWorkbookBeforeClose(ByRef Cancel As Boolean) 
     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False 
     
     'Evaluate if workbook is saved and emulate default propmts
    With ThisWorkbook 
        If Not .Saved Then 
            Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _ 
                vbYesNoCancel + vbExclamation) 
            Case Is = vbYes 
                 'Call customized save routine
                Call customSave 
            Case Is = vbNo 
                 'Do not save
            Case Is = vbCancel 
                 'Set up procedure to cancel close
                Cancel = True 
            End Select 
        End If 
         
         'If Cancel was clicked, turn events back on and cancel close,
         'otherwise close the workbook without saving further changes
        If Not Cancel = True Then 
            .Saved = True 
            Application.EnableEvents = True 
            .Close savechanges:=False 
        Else 
            Application.EnableEvents = True 
        End If 
    End With 
End Sub 
 
Public Sub OnWorkbookBeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False 
     
     'Call customized save routine and set workbook's saved property to true
     '(To cancel regular saving)
    Call customSave(SaveAsUI) 
    Cancel = True 
     
     'Turn events back on an set saved property to true
    Application.EnableEvents = True 
    ThisWorkbook.Saved = True 
End Sub 
 
Private Sub customSave(Optional SaveAs As Boolean) 
    Dim newFileName As String 
     
     'Turn off screen flashing
    Application.ScreenUpdating = False 
     
    Call prepareWorkbookForSave 
     
     'Save workbook directly or prompt for saveas filename
    If SaveAs = True Then 
        newFileName = Application.GetSaveAsFilename( _ 
        fileFilter:="Excel Files (*.xls), *.xls") 
        If Not newFileName = "False" Then ThisWorkbook.SaveAs newFileName 
    Else 
        ThisWorkbook.Save 
    End If 
     
     'Restore screen updates
    Application.ScreenUpdating = True 
End Sub 
 
Private Sub prepareWorkbookForSave() 
    Call unlockInterface(True) 
     
    Worksheets(INTERFACE_SHEET).Activate 
    With Range(STATUS_CELL) 
        .Value = "" 
        .Interior.Color = COLOR_WHITE 
    End With 
     
    Dim calcButton As Shape 
    Set calcButton = ActiveSheet.Shapes("CalculateButton") 
    calcButton.Visible = False 
     
    Dim resetButton As Shape 
    Set resetButton = ActiveSheet.Shapes("ResetButton") 
    resetButton.Visible = False 
     
    Dim macroMessage As Shape 
    Set macroMessage = ActiveSheet.Shapes("MacroMessage") 
    macroMessage.Visible = True 
     
    Call protectWorkbook 
End Sub 
 
Private Sub protectWorkbook(Optional enableProtection As Boolean = True) 
    Dim w As Worksheet 
     
    If enableProtection = True Then 
        For Each w In Worksheets 
            If w.ProtectContents = False Then 
                If w.Name = INTERFACE_SHEET Then 
                    w.Protect Password:=PROTECTION_INTERFACE 
                Else 
                    w.Visible = xlSheetVeryHidden 
                    w.Protect Password:=PROTECTION_NONINTERFACE 
                End If 
            End If 
        Next 
    Else 
        For Each w In Sheets 
            If w.ProtectContents = True Then 
                If w.Name = INTERFACE_SHEET Then 
                    w.Unprotect Password:=PROTECTION_INTERFACE 
                Else 
                    w.Unprotect Password:=PROTECTION_NONINTERFACE 
                End If 
            End If 
             
            w.Visible = xlSheetVisible 
        Next 
    End If 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


I also posted this question to ExcelForums.

I'm trying to set up an Excel (2010) spreadsheet to generate price quotes. I want to pull pricing information from a separate Excel workbook that I get directly from my supplier. I must emphasize that I cannot change the format of my supplier's list -- I must work with it as it was given to me.

The first sheet of my supplier’s workbook is a list of hundreds of engines. Each record has a corresponding number pointing to one of 13 other worksheets that contain labor charges for repairing these engines. Since there are many more engines than labor worksheets, there’s a many-to-few relationship at work here where dozens of different engine records could point to the same labor charge worksheet. Here’s a brief example:

CODE..........ENGINE..................................................SEE LABOR SHEET
BED200.....BEDFORD 200 DIESEL *4CIL* 98.4mm.........................4
BED300.....BEDFORD 300 DIESEL *4CIL* 98.4mm.........................4
BED350.....BEDFORD 350 DIESEL *4CIL* 106.3mm........................6

Here’s a snapshot of one of those 13 worksheets in the same file that contain labor charges:

CODE..........REPAIR..................................................LABOR CHARGE
10...............Rebuild cylinders....................................205.61
20...............Change Piston Injectors...........................74.24
30...............Re-machine camshaft throats.....................411.23
33...............Microscan of crankshaft surfaces...............258.21

Near the top (cell B6) of my separate price quote spreadsheet I have a drop down list for selecting an engine. (This drop down list functions fine – I don’t need help with it.) Once I select an engine, however, I want Excel to identify the corresponding worksheet containing labor charges and then automatically go get that information and bring it into my price quote.

My thinking was to capture the page number for the labor sheet as a variable, and then use that variable to tell Excel what worksheet to go to in order to get the prices. The VBA code below identifies the variable SheetNumber and attempts to identify it using a =VLOOKUP command. (Can I do that?) I’m trying to take the engine selected in cell B6 of my price quote and then go to the Motors sheet of file Master.xls and find the page number (in col 3) that corresponds with that engine. I want this variable to end up being an integer (1-13) representing the worksheet where the labor charges for the selected motor reside.


	VB:
	
 
SheetNumber = (=VLOOKUP(B6,MASTER.XLS[MOTORS]!$A$1:$C$500,3,False)) 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Below that I have a long list of almost identical lines of code that tell Excel to go to the worksheet (held in variable SheetNumber) and retrieve prices for each labor category. I want Excel to bring only the price information back to my price quote form. Here’s one of those (200+) lines of code.


	VB:
	
)) 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
My approach simply doesn’t work. Excel chokes at the first VLOOKUP command where I’m identifying my variable.
1. How can I identify a worksheet number based on the engine the user selects in cell B6 and then save that number as a variable for later use?
2. How can I then use that variable’s value to tell Excel to go to a specific worksheet in a separate file and retrieve corresponding pricing information?

Sorry for the long question. Any help is appreciated.

Morning All,

I was just wondering if it was possible to force a user to save a file before they could print a the spreadsheet?

Or would it best to put a button on the form for them to do so? If so what code would do this. I know you can just do Worksheets.Save method but how would this join on to go next to to the Print function?

Thanks All

I am working VBA EXCEL Project. Which consist of 7 workbooks on whole.

Workbook-1 I have made a dashboard (on sheet1)with 60 command buttons in reference to 60 worksheet of the workbook.
On Dashboard Each button when clicked it would activate the respective sheet and i have inserted a button in a each sheet to go back to dashboard.

Q1) Now doing this the file is about 54MB and takes long time to load, save and to open, Is there a solutions as to make this work differently.and make it work easily?

Secondly I have made a similar workbook using user-form- Everything is fine, works fast , uploads well, but the dashboard had to be closed each time when the page is activated and have to be reactivated to go to the next sheet.

Q2) Is there a way to auto minimize the userform when sheet is activated and with a click to maximize the userform back?if so i would need a function to do so.

Q3) Can i link with command button or any other form all the 7 workbooks? PS all workbook has 60 sheets similar to workbook-1 and I have tried putting the path still it wont read? I need the function to use to open the other workbooks one at a time when needed?

Thanks in advance
I just need help with either Q1 or Q2 which ever is better. Q3 is a must

hi there.. I have the following code that currently works like this

I click on a form button and the code looks for a file in a predefined directory
if it does not find the same file in the directory it saves the active sheet only and a message pops up and says the file has just been saved
if it does find the file it asks if you want to overwrite the file.... if you say yest it overwrites the active sheet and saves
if you say no it offers you a chance to enter another value at the end of the file name..... I thought this was going to work well for me but the problem is that after the active sheet is saved by itself it loses all of the code that I have in my workbook and many of the functions no longer work unless the master sheet is open.

is there any way that i can adjust this code to do the following:

click on button to save file
code looks for filename in directory
if filename does not exist WORKBOOK saves to atht location but the 5 inactive sheets "HIDE"
if filename exists message pops up and asks to over write
if you say yes file saves and 5 inactive sheets "hide"
if you say no then input box appears and lets you add a value to the end of the file name saves workbook with 5 inactive sheets "hidden"
after file saves message box appears and asks if you want to print the active workbook and close the master workbook copy without saving

here is the code I have now


	VB:
	
 SaveActiveSheet() 
     
    Dim f As String 
     
    ActiveSheet.Copy 
     
    On Error Goto userC 
     
    If Dir("C:Documents and SettingskennyDesktopestimates 05" & [c5].Value & [G124].Value & [H124].Value & ".xls") = "" Then 
        ActiveWorkbook.SaveAs Filename:="C:Documents and SettingskennyDesktopestimates 05" & [c5].Value & [G124].Value &
[H124].Value & ".xls" 
        MsgBox "your worksheet has just been saved!" 
        ActiveWorkbook.Close False 
    Else 
        i = MsgBox("Overwrite existing file...?", vbYesNo) 
        Application.DisplayAlerts = False 
        If i = 6 Then 
            ActiveWorkbook.Save 
             
             ' Added an 'else' statement here
        Else 
            f = InputBox("Enter a new estimate #...", Title:="Enter filename without '.xls'") 
            If f = "" Then 
                Exit Sub 
            End If 
            ActiveWorkbook.SaveAs Filename:="C:Documents and SettingskennyDesktopestimates 05" & [c5].Value & [G124].Value &
f & ".xls" 
             'End of added code
            ActiveWorkbook.Close False 
        End If 
    End If 
     
    Exit Sub 
     
userC: 
     
    MsgBox "you need to change your estimate number" 
    ActiveWorkbook.Close False 
    Exit Sub 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

any help on this would be appreciated

I woudl like to have an application offer users the facility to add more entries to a list on an Excel worksheet. This can be done by a variety of forms techniques with the data saved to the worksheet or to an Access database.

But waht happens if I want to have some formulae hanging off the list? Say if I have a list of numbers with a sum formula in the cell at the bottom. If I use the Excel data form facility it works fine to add new numbers to the list but as soon as I add a sum formula in the bottom cell it doesn't work properly anymore.

What I really need is the capability to add new records to the list and the formulae to adjust accordingly in the way that, say, inserting a row works.

I guess I could do this by writing a VBA application that displayed a form, took new records, added them to a database, displayed the records when required and formatted the worksheet accordingly with the formulae I wanted.

But this seems like a lot of work for what appears to be a commonly required piece of functionality. And thus might already be available.

Any suggestions?

Thanks

david

Hi guys,

I'm a newbie on here and new to VBA. I have been asked to develop a userform to collect data and save it to an excel spreadsheet - which i have managed to do.

I now need to add functionality to the userform to search for specific data range in a column on the worksheet and pull into the userform any related data which has been previously populated via the userform.

I.e - user partially completes the form and saves the data to a worksheet.
When the user reopens the userform and selects (listbox of relevant values) or types in the data string they are looking for, the form automatically pulls in all the data that belong to that record set.

The user can then complete more fields on the form and any changes/updates are saved to the excel worksheet.

I have managed to find bits of code that do different things, but I am struggling to associate the recordset based on the criteria the user enters via keying in or selecting from the listbox.

I feel like I am going round in circles with this and hence the request for help.

Any ideas/suggestions greatfully received

TIA
Paul

Hi everyone,

I'm a bit verbose, so bear with me.

I've written a macro that asks the user to specify the proper workbook to open (via an input box), and then the rest of the macro will carry out multiple functions to a specific sheet within the workbook. The reason for the macro is that several people will name the same document with different file names. However the worksheet within the workbook will remain the same. For example, Workbook_Mon is saved by user A, and Workbook_Tues is saved by user B. But both workbooks have the same worksheet named Worksheet_Immutable.

The workbook is activated, but I run into a problem when the worksheet is specified. See code below:

Dim ResearchRequestForm As Worksheets
strFilename = InputBox("Enter the Workbook Name" _
& vbCrLf & "Include file extension.", "Input File Name", "")
Application.ScreenUpdating = False
'Declares the ClientName
ActiveWorkbook.Activate
Sheets("Research Request Form").Select [MACRO STOPS HERE]
Range("C6:F6").Select
Selection.Copy
Workbooks("Project Tracking Sheet").Activate
Sheets("2008").Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

I'm appreciative of any help!

Short answers:
Yes - you can use VLOOKUP() within nested (IF) statements.
No - VLOOKUP() only returns a single value out of the matched row
No - VLOOKUP() can't return data to the left of the column the match is
sought in, But!! the LOOKUP() function can do that.

All of the various lookups (HLOOKUP, VLOOKUP and LOOKUP) are pretty much
limited to finding the first entry meeting the lookup parameters, although
LOOKUP can be used to "You can also use the LOOKUP function as an alternative
the IF function for elaborate tests or tests for more than seven conditions.
See the examples in the array form." - from the Help topic on LOOKUP

But in your case, I think that a macro is probably going to be the better
way to develop a solution since you want to return entire rows and you need
to look for mulitple occurances of the same value in your data.

Not knowing how familiar you are with writing macros or coding in general,
it's difficult to point you to far. But I'll give a rough logic flow for you:

The could would have to go to the sheet with the list of charge codes to
find on the other sheets and then loop through all cells containing those
charge codes, on at a time, saving the contents for comparisons on the other
sheets. Then for each sheet with data to be matched it would go to the
beginning of the list and look through it for matches and on each match, copy
that row to a sheet designated to be used to receive those rows of
information, then move to next sheet and repeat and once it has examined all
sheets, then move to the next cell on your charge code sheet, get the next
lookup value and work through the other sheets from beginning to end again.
This could be quite time consuming if you have really long lists.

Do you want to give the macro solution a shot?

"Aine" wrote:

> Hi All,
>
> Sorry, this may seem like an elementary question but....
>
> First of all I have three seperate worksheets containing data within my
> workbook.
>
> I want to return all rows from each of those worksheets that matches a
> certain criteria to another worksheet, without having to manipulate the
> data.
>
> e.g.
> I have charge codes beginning in 1-90XX, 1-91xx, etc...
> These appear multiple times in the worksheets that contain data
> I want to search sheets 1 - 3 to see if any rows contain them & if they
> do, I want all these complete rows to appear in another worksheet
> within that same workbook.
>
>
>
> VLOOKUP function will not work for me as the charge code is in column O
> & I can only get it to return data within that row for column O onward.
>
> Also, I am unsure if you can get VLOOKUP to check for multiple
> conditions
>
> * What function should I be using?
> * Can you use VLOOKUP in a nested statement to search for the various
> conditions(charge codes)?
> * Can VLOOKUP return a whole row, without having to specify the column?
> * Can VLOOKUP return data previous to the column where the criteria of
> the search is met?
>
> * Finally: Should I try to use Macros & if so, can someone point me in
> the right direction???
>
>
> Thanks,
>
> Aine
>
>

I created a custom quote worksheet with a lot of lookups, validated tables
and functions. Even though I named the worksheet "ORDER FORM - Open and SAVE
AS or I'll cut your fingers off", people still get in and overwrite my
formulas and save instead of save as.

The problem is, sometimes they do need to overwrite, but I need to have the
worksheet stay intact when they exit.

Can you force a worksheet to exit without saving changes, or force a "save
as"?

I do have a backup copy hidden that I can always go to, but I'd like to
force the stupid people in my office to save as.

Thanks,
Susan

I am using the following track changes code on a worksheet;

Track/Report User Changes on an Excel Worksheet/Workbook

in the this Workbook. It involves two different VBA solutions I had gotten form Ozgrid. The top part is VBA code to track changes in the workbook, THe instructions are to put the statement at the top of the module which I did. When it gets to the second VBA code {Starting with Option Explicit} below, I get an error message that "Only comments may appear after End Sub, End Function or End Property.

Also, I would like to get the VBA course offered on this website, any comments?

Help! Thanks!


	VB:
	
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    Dim bBold As Boolean 
     
    If Target.Cells.Count > 1 Then Exit Sub 
    On Error Resume Next 
     
    With Application 
        .ScreenUpdating = False 
        .EnableEvents = False 
    End With 
     
    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell" 
    bBold = Target.HasFormula 
    With Sheet1 
        .Unprotect Password:="Secret" 
        If .Range("A1") = vbNullString Then 
            .Range("A1:G1") = Array("CELL CHANGED", "OLD VALUE", _ 
            "NEW VALUE", "TIME OF CHANGE", " DATE OF CHANGE", "SHEET NAME", "USER") 
        End If 
         
         
        With .Cells(.Rows.Count, 1).End(xlUp)(2, 1) 
            .Value = Target.Address 
            .Offset(0, 1) = vOldVal 
            With .Offset(0, 2) 
                If bBold = True Then 
                    .ClearComments 
                    .AddComment.Text Text:= _ 
                    "OzGrid.com:" & Chr(10) & "" & Chr(10) & _ 
                    "Bold values are the results of  formulas" 
                End If 
                .Value = Target 
                .Font.Bold = bBold 
            End With 
             
            .Offset(0, 3) = Time 
            .Offset(0, 4) = Date 
            .Offset(0, 5) = Sh.Name 
            .Offset(0, 6) = Application.UserName 
        End With 
        .Cells.Columns.AutoFit 
        .Protect Password:="Secret" 
    End With 
    vOldVal = vbNullString 
     
    With Application 
        .ScreenUpdating = True 
        .EnableEvents = True 
    End With 
     
    On Error Goto 0 
     
End Sub 
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 
    vOldVal = Target 
End Sub 
 
Option Explicit 
 'Module level declarations
 '
 'IsClosed is used to detect whether the user selects Cancel
 'when the workbook is being closed and it hasn't been saved
 '
 'IsOpen is used to detect whether the workbook has just been
 'opened or is simply being reactivated
 '
Dim IsClosed As Boolean, IsOpen As Boolean 
 
Private Sub Workbook_Activate() 
    IsClosed = False 
    If IsOpen = False Then 
         'this is not the the first activation after the
         'workbook is opened, ie its a reactivation
        Module1.CMVisibility (True) 
         'call the routine to switch visibility of the custom menu
    End If 
End Sub 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
     'when a workbook is being closed, if there have been changes and
     'the workbook hasn't been saved Excel will prompt the user with
     'a warning message "Do you want to save the changes ..."
     'If the user selects Cancel we do not want to delete the menu, but
     'you can't actually detect the 'Cancel', this is a parameter
     'that is passed to the event (see Case Is = vbCancel section)
     'therefore, if the workbook has not been saved we add our own message
     'to the BeforeClose event (see below)
    Dim ans As Integer 
    If Not ThisWorkbook.Saved Then 
        ans = MsgBox(prompt:="Do you want to save the changes to " _ 
        & ThisWorkbook.Name, _ 
        Buttons:=vbInformation + vbYesNoCancel, Title:="Microsoft Excel2") 
        Select Case ans 
        Case Is = vbYes 'user wants to save
            IsClosed = True 'closing so set to True
            ThisWorkbook.Save 'save workbook
        Case Is = vbNo 'user doesn't want to save
            IsClosed = True 'closing so set to True
            ThisWorkbook.Saved = True 'don't save workbook
        Case Is = vbCancel 'changed their mind so don't close
            IsClosed = False 'changed their mind, set to False
            Cancel = True 'cancel the closing process
            Exit Sub 
        End Select 
    End If 
End Sub 
 
Private Sub Workbook_Deactivate() 
    IsOpen = False 
     'set to false so that when the workbook is reactivated the
     'Activate event will know that the workbook hasn't just been opened
    If IsClosed = True Then 
         'the workbook is being closed (as determined by the BeforeClose event)
        Module1.DeleteCM 
         'call the routine to delete the custom menu
    Else 
         'the user has only activated another Workbook
        Module1.CMVisibility (False) 
         'call the routine to switch visibility of the custom menu
    End If 
End Sub 
 
Private Sub Workbook_Open() 
    IsClosed = False 
    IsOpen = True 
     'initialise the IsClosed and IsOpen variables
    Module1.CreateCM 
     'call the routine to show the custom menu
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Currently I have an excel form that I am working on. I just figured out how to get it to open when I open the workbook. I am wondering is there code out there that will prompt excel to auto save the worksheet that the form writes to when the "OK" button on my form is clicked. I want to be able to save the data without having to rely on the user to remember to save everytime entry is complete. Please if there is a code for this function, where would I place it in my code listing? Also, what is the code for it?

Thank you in advance!

Ken