Running Macro in multiple workbooks

D

depcdivr

Active Member
Joined
Jan 21, 2008
Messages
349
Office Version
  1. 365
Platform
  1. Windows
I have a userform that will upon initialization, open a new workbook then with that workbook it will create a new worksheet called "quote". I then prompt the user for some information in the userform. When the user clicks the next button I want to copy the information to certain cells in the new workbook and close the userform. After the information is copied I want to open another userform that was in the original Excel workbook.

I have a few issues.

1) How can I format the cells in the newly created workbook. Originally I had this code written to only create a new worksheet and when I did that the formatting would work fine. Now that it is in a new workbook the formatting isn't working.

2) How can I open the next userform in the original workbook? I get a runtime error '9' subscript out of range on the line of code that has Contact_info.Show I am assuming it is because it is trying to open the contact_info userform in the new workbook. Is that correct?

Here is the code that I am using for the first userform.

Code: 
Dim WB_Macro As Workbook
Dim WB_Quote As Workbook
Dim wsNew As Worksheet
Private Sub UserForm_Initialize()
Set territoryws = Worksheets("Quote Lists")
'Populates combobox with range
For Each cPart In territoryws.Range("$A2:$A40")
  With Me.terr_num1
    .AddItem cPart.Value
    .List(.ListCount - 1, 1) = cPart.Offset(0, 1).Value
  End With
Next cPart
 
' creates new quote worksheet

Set WB_Macro = ThisWorkbook
Set WB_Quote = Workbooks.Add
Set wsNew = WB_Quote.Worksheets.Add
wsNew.Name = "Quote"

'MsgBox WB_Macro & WB_Quote
Exit Sub
 
 
'Formats rows and columns
    wsNew.Columns("A:A").ColumnWidth = 0.69
    wsNew.Columns("b:b").ColumnWidth = 8.75
    wsNew.Columns("c:c").ColumnWidth = 11.5
    wsNew.Columns("d:d").ColumnWidth = 7.5
    wsNew.Columns("e:e").ColumnWidth = 6.25
    wsNew.Columns("f:f").ColumnWidth = 11.25
    wsNew.Columns("g:g").ColumnWidth = 5.63
    wsNew.Columns("h:h").ColumnWidth = 5.01
    wsNew.Columns("i:i").ColumnWidth = 5.75
    wsNew.Columns("j:j").ColumnWidth = 7.5
    wsNew.Columns("k:k").ColumnWidth = 8.75
    wsNew.Columns("l:l").ColumnWidth = 20.63
    wsNew.Columns("m:m").ColumnWidth = 8.13
    wsNew.Columns("n:n").ColumnWidth = 13.75
    wsNew.Columns("o:o").ColumnWidth = 13.13
    wsNew.Columns("p:p").ColumnWidth = 5.63
    
    wsNew.Rows("1:1").RowHeight = 51.75
    wsNew.Rows("2:2").RowHeight = 20.25
    wsNew.Rows("3:3").RowHeight = 21
    wsNew.Rows("4:18").RowHeight = 16.5
    wsNew.Rows("19:19").RowHeight = 6.75
    wsNew.Rows("20:22").RowHeight = 16.5
    wsNew.Rows("21:21").RowHeight = 41.25
    wsNew.Rows("22:22").RowHeight = 6.75
    wsNew.Rows("23:26").RowHeight = 19.5
    wsNew.Rows("27:27").RowHeight = 41.25
    wsNew.Rows("28:90").RowHeight = 16.5
'Merges Cells for template
    wsNew.Range("B3:I4").Select
    Selection.Merge
    wsNew.Range("B5:G5").Select
    Selection.Merge
    wsNew.Range("m3:o3").Select
    Selection.Merge
    wsNew.Range("m4:o4").Select
    Selection.Merge
    wsNew.Range("m5:o5").Select
    Selection.Merge
    wsNew.Range("c17:O18").Select
    Selection.Merge
    wsNew.Range("B21:C21").Select
    Selection.Merge
    wsNew.Range("D21:F21").Select
    Selection.Merge
    wsNew.Range("G21:M21").Select
    Selection.Merge
    wsNew.Range("N21:o21").Select
    Selection.Merge
    wsNew.Range("B20:C20").Select
    Selection.Merge
    wsNew.Range("D20:F20").Select
    Selection.Merge
    wsNew.Range("G20:M20").Select
    Selection.Merge
    wsNew.Range("N20:O20").Select
    Selection.Merge
    wsNew.Range("D23:F23").Select
    Selection.Merge
    wsNew.Range("G23:M23").Select
    Selection.Merge
    wsNew.Range("D24:F24").Select
    Selection.Merge
    wsNew.Range("G24:M24").Select
    Selection.Merge
    wsNew.Range("d10:i15").Select
    Selection.Merge
    
    
'Formats borders & colors & Fonts
    Cells.Select
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    
   
wsNew.Columns("A:Z").Select
    Range("A1").Activate
    With Selection.Font
        .Name = "Times New Roman"
 '       .Name = "Arial Narrow"
        .Size = 14
    End With
   
wsNew.Range("m5,m3,o3,B23:O23,B20:O20,N25,B21:o21").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    wsNew.Range("M3,B21:o21").Select
    With Selection.Font
        .Size = 16
    End With
    
    wsNew.Range("L29").Select
    With Selection.Font
        .Name = "Monotype Corsiva"
        .Size = 18
    End With
    
    wsNew.Range("o4").Select
     Selection.Font.Bold = True
     With Selection.Font
        .Size = 16
        .ColorIndex = 5
        End With
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    
    wsNew.Range("C17:O18").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    
    wsNew.Range("c10,M8,m10,M12:m14,m31:m33").Select
    With Selection
        .HorizontalAlignment = xlRight
    End With
    wsNew.Range("N8,N10,N12,N13,N14").Select
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    wsNew.Range("D10").Select
    With Selection
        .VerticalAlignment = xlTop
    End With
    
        
    wsNew.Range("M3:O5, B20:o21, B23:O24").Select
    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(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("M3:O3, B20:o20, B23:o23").Select
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
    
     
 
 'Populates Cells in form template
    wsNew.Cells(3, 2) = "Two Technology Place, East Syracuse, NY  13057-9714" & Chr(10) & "Phone  315.434.1100 or 800.223.0633    Fax  315.434.2520"
    wsNew.Cells(5, 2) = "DUNS:  05-055-2082"
    wsNew.Cells(3, 13) = "QUOTATION"
    wsNew.Cells(10, 3) = "To :"
    wsNew.Cells(5, 13) = "When replying refer to this number"
    wsNew.Cells(8, 13) = "Date :"
    wsNew.Cells(10, 13) = "Reference : "
    wsNew.Cells(14, 13) = "Email : "
    wsNew.Cells(12, 13) = "Phone : "
    wsNew.Cells(13, 13) = "Fax : "
    
    wsNew.Cells(33, 13) = "Email : "
    wsNew.Cells(31, 13) = "Phone : "
    wsNew.Cells(32, 13) = "Fax : "
    
    wsNew.Cells(17, 3) = "Thank you for your recent inquiry. We are pleased to submit the following quotation," & Chr(10) & "subject to the Terms and Conditions of Sale attached or on reverse side hereof."
    wsNew.Cells(20, 2) = "Estimated Ship Date"
    wsNew.Cells(20, 4) = "Quote Valid for"
    wsNew.Cells(20, 7) = "Freight Terms "
    wsNew.Cells(20, 14) = "Terms "
    wsNew.Cells(23, 2) = "Item No."
    wsNew.Cells(23, 3) = "Quantity"
    wsNew.Cells(23, 4) = "INFICON Part No."
    wsNew.Cells(23, 7) = "Description"
    wsNew.Cells(23, 14) = "Unit Price"
    wsNew.Cells(23, 15) = "Amount"
    wsNew.Cells(25, 14) = "Net Total"
    
    
    Dim Pic2       As Object
    Worksheets("quote generator").Pictures("INFICON LOGO").Copy
    With Worksheets("quote")
      .Paste
      Set Pic2 = Selection
      Pic2.Left = Range("A1").Left
      Pic2.Top = Range("A1").Top
      Selection.ShapeRange.IncrementLeft 11.25
      Selection.ShapeRange.IncrementTop 16.5
    End With
   

'Sheets("Quote").Select
'ActiveWindow.Zoom = 75

End Sub
Private Sub Back1_Click()
Unload Me
    
End Sub
Private Sub Next1_Click()
If Trim(Me.terr_num1.Value) = "" Then
    MsgBox "Please select an account manager"
    Exit Sub
End If
    
Set ws = WB_Macro.Worksheets("Quote Lists")
temp = Me.terr_num1

Rep_Phone = Application.WorksheetFunction.VLookup(temp, ws.Range("$A$2:$G$9999"), 3, False)
Rep_company = Application.WorksheetFunction.VLookup(temp, ws.Range("$A$2:$G$9999"), 2, False)
Rep_email = Application.WorksheetFunction.VLookup(temp, ws.Range("$A$2:$G$9999"), 5, False)
Rep_fax = Application.WorksheetFunction.VLookup(temp, ws.Range("$A$2:$G$9999"), 4, False)

wsNew.Cells(4, 13) = Me.Quote_Number
If Trim(Me.author.Value) = "" Then
    wsNew.Cells(29, 12) = Me.terr_num1
Else
    wsNew.Cells(29, 12) = Me.terr_num1 + "/" + Me.author
End If
wsNew.Cells(31, 12) = Me.terr_num1
wsNew.Cells(32, 12) = Rep_company
wsNew.Cells(31, 14) = Rep_Phone
wsNew.Cells(32, 14) = Rep_fax
wsNew.Cells(33, 14) = Rep_email

wsNew.Cells(8, 14) = "=today()"
Unload Me
Contact_info.Show
End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Originally I had this code written to only create a new worksheet and when I did that the formatting would work fine.
Click to expand...

Why not create a new worksheet in your current book and then move it without specifying a destination - this will put it into a new workbook.

I'm afraid I don't really understand your second question - hopefully someone else will.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
74
Micron
M
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
862
kerm007
K
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
332
RoryA
RoryA
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
188
6StringJazzer
6StringJazzer
S
  • Question
vba logic to open up several files within a folder and perform 2-3 steps
Replies
1
Views
114
ranman256
ranman256

Forum statistics

Threads
1,214,983
Messages
6,122,598
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top