Hi,

I'm trying to get my macro make a message come up and ask the customer
to choose company a or b. Then based on the result, i can open the
correct file.

I'm great at Excel, but this VB code has me stumped. Any help would be
appreciated. Other than that I'll have to make two separate macros.

Thanks,

Michele

One way:


Dim vResponse As Variant
Do
vResponse = LCase(Application.InputBox( _
Prompt:="Enter 'a' or 'b'", _
Default:="a", _
Title:="Choice", _
Type:=2))
If vResponse = False Then Exit Sub 'User Cancelled
Loop Until vResponse = "a" Or vResponse = "b"




In article .com,
wrote:

Hi,

I'm trying to get my macro make a message come up and ask the customer
to choose company a or b. Then based on the result, i can open the
correct file.

I'm great at Excel, but this VB code has me stumped. Any help would be
appreciated. Other than that I'll have to make two separate macros.

Thanks,

Michele

I've got this far, but the user can only choose one company. How can I
make both choices visible? And what does type 2 mean. I'm tried to
get a VB book, but the library is closed for the long weekend in
Canada.

Dim vResponse As Variant
Do
vResponse = LCase(Application.InputBox( _
Prompt:="Choose quote from Custom Safety or Severn
Tech", _
Default:="Custom Safety", _
Title:="Which company is quoting?", _
Type:=2))
If vResponse = False Then Exit Sub 'User Cancelled
Loop Until vResponse = "Custom Safety" Or vResponse = "Severn Tech"

If vResponse = True Then
If IsFileOpen("C:\Documents and Settings\John\My
Documents\quoteprogramfiles\csquoteform.xls") Then
MsgBox "Quote form is open. Save and close form
(csquoteform.xls) and try again."
Exit Sub
End If
End If

If vResponse = False Then
If IsFileOpen("C:\Documents and Settings\John\My
Documents\quoteprogramfiles\stquoteform.xls") Then
MsgBox "Quote form is open. Save and close form
(stquoteform.xls) and try again."
Exit Sub
End If
End If

If vResponse = True Then
Workbooks.Open filename:= _
"C:\Documents and Settings\John\My
documents\quoteprogramfiles\csquoteform.xls"
End If

If vResponse = False Then
Workbooks.Open filename:= _
"C:\Documents and Settings\John\My
documents\quoteprogramfiles\stquoteform.xls"
End If

Thanks again,

Michele


JE McGimpsey wrote:
One way:


Dim vResponse As Variant
Do
vResponse = LCase(Application.InputBox( _
Prompt:="Enter 'a' or 'b'", _
Default:="a", _
Title:="Choice", _
Type:=2))
If vResponse = False Then Exit Sub 'User Cancelled
Loop Until vResponse = "a" Or vResponse = "b"

In article .com,
wrote:

Hi,

I'm trying to get my macro make a message come up and ask the
customer
to choose company a or b. Then based on the result, i can open the
correct file.

I'm great at Excel, but this VB code has me stumped. Any help
would be
appreciated. Other than that I'll have to make two separate
macros.

Thanks,

Michele

Well, XL/VBA Help should be open...

The loop restricts the users choice, returned in vResponse, to either
Custom Safety or Severn Tech.

However, you test for True or False.

One possibility:


Do
'get vResponse
Loop Until...

If vResponse = "Custom Safety" Then
If IsFileOpen("C...\csquoteform.xls") Then
MsgBox...
Exit Sub
Else
Workbooks.Open filename:="C...\csquoteform.xls"
End If
Else
If IsFileOpen("C...\stquoteform.xls") Then
MsgBox...
Exit Sub
Else
Workbooks.Open filename:="C...\stquoteform.xls"
End If
End If


However this would be better:

Const sPATH = "C:\Documents...\quoteprogramfiles\"
Dim sFileName As String
Do
'get vResponse
Loop Until...

If vResponse = "Custom Safety" Then
sFileName = "csquoteform.xls"
Else
sFilename ="stquoteform.xls"
End If
If IsFileOpen(sPATH & sFileName) Then
MsgBox "Quote form is open. Save and close form (" & _
sFileName & ") and try again."
Exit Sub
Else
Workbooks.Open sPATH & sFileName
End If


In article . com,
wrote:

I've got this far, but the user can only choose one company. How can I
make both choices visible? And what does type 2 mean. I'm tried to
get a VB book, but the library is closed for the long weekend in
Canada.

Dim vResponse As Variant
Do
vResponse = LCase(Application.InputBox( _
Prompt:="Choose quote from Custom Safety or Severn
Tech", _
Default:="Custom Safety", _
Title:="Which company is quoting?", _
Type:=2))
If vResponse = False Then Exit Sub 'User Cancelled
Loop Until vResponse = "Custom Safety" Or vResponse = "Severn Tech"

If vResponse = True Then

Another way:

This is more complex but IMHO more elegant. It is intended to be used for
the situation where there is a variable number of companies to select from.
The companies must be listed on a worksheet ("Settings"). Typically, this
helper worksheet would be hidden. It creates on-the-fly a userform that that
has the same number of option buttons as companies in the list. The option
button captions are the same as the company names. It was written only
minutes ago and briefly tested so it likely could be improved. It can, of
course, be adapted to suit.

You need to:
1) Paste the code to a standard code module
2) Name a worksheet "Settings"
3) List in sheet "Settings" multiple company names in column A starting at
cell A1
4) Call the macro

The macro will return in a message box the user's selection. It is assumed
that you will do whatever with the result. The userform will self-delete.

Regards,
Greg

Const UFColor As Single = 10040115
Public UserSelection As String
Sub MakeUF()
Dim UF As Object
Dim Ctrl As Object
Dim rng As Range
Dim i As Integer
Dim Code As String

With Sheets("Settings")
Set rng = Intersect(.Range("A1").CurrentRegion, .Columns(1))
End With
Set UF = Application.VBE.ActiveVBProject.VBComponents.Add(3 )
UF.Properties("Width") = 170
UF.Properties("Caption") = "File selection"
With UF.Designer
Set Ctrl = .Controls.Add("Forms.Label.1")
With Ctrl
..Caption = "Select company..."
..ForeColor = UFColor
..Top = 5
..Left = 5
..Height = 15
..Width = 200
End With
For i = 1 To rng.Count
Set Ctrl = .Controls.Add("Forms.OptionButton.1")
With Ctrl
..Caption = rng(i, 1).Value
..ForeColor = UFColor
..Top = 20 + (i - 1) * 15
..Left = 5
..Height = 15
..Width = 150
..Value = (i = 1)
End With
Next
Set Ctrl = .Controls.Add("Forms.CommandButton.1")
With Ctrl
..Caption = "Apply"
..ForeColor = UFColor
..Top = 30 + (i - 1) * 15
..Left = 5
..Height = 20
..Width = 75
End With
Set Ctrl = .Controls.Add("Forms.CommandButton.1")
With Ctrl
..Caption = "Cancel"
..ForeColor = UFColor
..Top = 30 + (i - 1) * 15
..Left = 85
..Height = 20
..Width = 75
End With
End With

UF.Properties("Height") = Ctrl.Top + 45

Code = "Private Sub CommandButton1_Click()"
Code = Code & vbCrLf & "Dim i As Integer"
Code = Code & vbCrLf & "For i = 1 To Me.Controls.Count - 3"
Code = Code & vbCrLf & "If Me.Controls(i) = True Then"
Code = Code & vbCrLf & "UserSelection = Me.Controls(i).Caption"
Code = Code & vbCrLf & "Exit For"
Code = Code & vbCrLf & "End If"
Code = Code & vbCrLf & "Next"
Code = Code & vbCrLf & "Unload Me"
Code = Code & vbCrLf & "End Sub"
Code = Code & vbCrLf & "Private Sub CommandButton2_Click()"
Code = Code & vbCrLf & "Unload Me"
Code = Code & vbCrLf & "End Sub"
UF.CodeModule.InsertLines 2, Code

VBA.UserForms.Add(UF.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove UF
MsgBox UserSelection
End Sub

Hi Greg,

Pretty fancy. Way beyond my understanding. Impressed the h out of me.

Can I put this inside of my current macro? I tried to and it didn't
like Public, said invalid attribute in sub or function. I didn't want
the user to have to run two macros.

I put your code at the beginning of my macro, and then after it I added
this just before the End Sub to be able to pass the correct filename to
work with further down in the macro.

If UserSelection = "Custom Safety" = True Then
qfFileName = "CSQuoteform.xls"
Else
qfFileName = "STQuoteform.xls"
End If

Thanks a bunch,

Michele

Hi,

I ran it as a separate macro and I'm getting 'programmatic access to
Visual Basic Project is not trusted' on this line:
Set UF = Application.VBE.ActiveVBProject.VBComponents.Add(3 )

Thanks,

Michele

You need to allow it in Tools=Macro=Security

I believe it is in the trusted sources tab (a checkbox). (I don't have
xl2002/xl2003 handy at the moment).

--
Regards,
Tom Ogilvy

wrote in message
oups.com...
Hi,

I ran it as a separate macro and I'm getting 'programmatic access to
Visual Basic Project is not trusted' on this line:
Set UF = Application.VBE.ActiveVBProject.VBComponents.Add(3 )

Thanks,

Michele

It worked great for me when I tested it. Have you got it to work at all?

If you potentially have more than just two companies to select from then I
think this is the way to go. However, I've never seen that error message
before. I suspect it's to do with virus protection or you have a later
version of Excel than I do. (Perhaps it has to do with all that Digital
Certificate stuff that I've never paid attention to).

I don't think it will help but it's worth a try: From the main menu bar
select ToolsMacroSecurity"Trusted Sources" tab. Then ensure that the
"Trust all installed Add-ins and Templates" checkbox is selected.

Another suggestion is, from the VBE, select ToolsReferences and then select
the "MicroSoft Forms 2.0 Object library". I can't think of a logical reason
why this would be helpful granted. If you are not successful, I suggest
posting separately to see if someone else can help.

Sorry I couldn't be more helpful. Be advised that I'm just an amateur if
that isn't clear already.

Regards,
Greg

" wrote:

Hi,

I ran it as a separate macro and I'm getting 'programmatic access to
Visual Basic Project is not trusted' on this line:
Set UF = Application.VBE.ActiveVBProject.VBComponents.Add(3 )

Thanks,

Michele

Hi Greg,

It works now. It was that trusted sources thing. I had to check
'Trust access to Visual Basic Project'.

It works as a separate macro, but I'd still like to include it at the
top of mine. Since I don't know where to put the top two lines, I'm
confused as to what to do.

Here is my macro. I'd like to replace the 'Which company to do quote
for?' section with your much better code.

Sub Quote()
'
' Quote Macro
' Macro recorded 5/17/2005 by Michele J. Jones
'
' Keyboard Shortcut: Ctrl+q

' Which company to do quote for?
Const qfPath = "C:\Documents and Settings\John\My
Documents\quoteprogramfiles\"
Dim qfFileName As String
Dim vResponse As Variant
If MsgBox("Is quote for Custom Safety?", vbYesNo + vbQuestion,
"Quoting Company") = vbYes Then
qfFileName = "CSQuoteform.xls"
Else
qfFileName = "STQuoteform.xls"
End If

' Quit if quote is open and open if not
If IsFileOpen(qfPath & qfFileName) Then
MsgBox "Quote form is open. Save and close form " & qfFileName
& " and try again."
Exit Sub
Else
Workbooks.Open qfPath & qfFileName
End If

' Go to CUST column A and copy fields
Windows("cust.xls").Activate
Selection.End(xlToLeft).Select
Dim fn
Dim ln
Dim cm
Dim a1
Dim a2
Dim ci
Dim pr
Dim pc
Dim ph
Dim fx
fn = ActiveCell.Value
Selection.Offset(0, 1).Select
ln = ActiveCell.Value
Selection.Offset(0, 1).Select
cm = ActiveCell.Value
Selection.Offset(0, 1).Select
a1 = ActiveCell.Value
Selection.Offset(0, 1).Select
a2 = ActiveCell.Value
Selection.Offset(0, 1).Select
ci = ActiveCell.Value
Selection.Offset(0, 1).Select
pr = ActiveCell.Value
Selection.Offset(0, 1).Select
pc = ActiveCell.Value
Selection.Offset(0, 1).Select
ph = ActiveCell.Value
Selection.Offset(0, 1).Select
fx = ActiveCell.Value

' Position CUST on First Name
Selection.Offset(0, -9).Select

' Paste FirstName and LastName
Windows(qfFileName).Activate
Range("B11").Select
Selection = fn
Selection.Offset(0, 1).Select
Selection = ln

' Join First and Last Names
Selection.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy

' Past Joined Name
Selection.Offset(0, -2).Select
ActiveSheet.Paste

' Remove OldJoined Name
Selection.Offset(0, 2).Select
Selection.ClearContents

' Remove Old LastName
Selection.Offset(0, -1).Select
Selection.ClearContents

' Paste Company, Address1, Address2, City, Prov & PC
Selection.Offset(-5, -2).Select
Selection = cm
Selection.Offset(1, 0).Select
Selection = a1
Selection.Offset(1, 0).Select
Selection = a2
Selection.Offset(1, 0).Select
Selection = ci
Selection.Offset(0, 1).Select
Selection = pr
Selection.Offset(0, 1).Select
Selection = pc

' Join City, Prov PC
Selection.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],"", "",RC[-2],""
"",RC[-1])"

' Make City, Prov PC into a value
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False

' Clear PC, Prov & City
Selection.Offset(0, -1).Select
Selection.ClearContents
Selection.Offset(0, -1).Select
Selection.ClearContents
Selection.Offset(0, -1).Select
Selection.ClearContents

' Merge City, Prov & PC Cells
Range("A9:C9").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With

' Copy City, Prov PC
Range("D9").Select
Selection.Copy

' Paste City, Prov PC
Range("A9").Select
ActiveSheet.Paste

' Clear Old City, Prov PC
Range("D9").Select
Selection.ClearContents

' Paste Phone & Fax
Selection.Offset(3, -1).Select
Selection = ph
Selection.Offset(1, 0).Select
Selection = fx

' Position Quote on Company
Selection.Offset(-7, -1).Select

End Sub

If you're an amateur, I'm in real trouble, but alas, this is not my
only day job.

Thanks again,

Michele