Submit Macro

gmazza76

Well-known Member
Joined
Mar 19, 2011
Messages
628
Office Version
  1. 365
Platform
  1. Windows
I am using VBA to save a form ( in Microsoft Excel 2007 ), but i need it to save to a different sheet in a workbook depending on the managers name
cmbMgr is the reference i need to match the data to.
I have 6 managers that it can be ( 6 seperate sheets ) that the below info needs to go into when saved

The macro below saves all the data to 1 sheet at the moment but needs splitting as above

Private Sub CommandButton1_Click()

If Me.txtdate.Value = "" Then
MsgBox "Please complete todays date"
Else
If Me.cmbMgr.Value = "" Then
MsgBox "You need to choose your TM name before you can raise a Car Park Query"
Else
If Me.cmbAdvocate.Value = "" Then
MsgBox "You need to complete the customer profile number before you can raise a Car Park Query"
Else
If Me.TextBox5.Value = "" Then
MsgBox "You need to complete the account number"
Else
If Me.TextBox3.Value = "" Then
MsgBox "You need to complete the customer name"
Else
If Me.ComboBox3.Value = "" Then
MsgBox "You need to complete your question catogery"
Else
If Me.TextBox6.Value = "" Then
MsgBox "You need to complete your question"
Else

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\Users\MAZZA\Documents\Gavin\Car Park\Data.xls"

Dim myBook As Workbook

On Error Resume Next
Set myBook = Application.Workbooks("Data.xls")
On Error GoTo 0

If myBook.ReadOnly Then
MsgBox "This file is being used by someone else please try again in a minute"
ActiveWorkbook.Close False
Else

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ActiveWorkbook.Sheets("Sheet1").Activate
ActiveSheet.AutoFilterMode = False

Range("A1").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

ActiveCell = txtdate
ActiveCell.Offset(0, 1) = txtdate.Value
ActiveCell.Offset(0, 2) = cmbMgr.Value
ActiveCell.Offset(0, 3) = cmbAdvocate.Value
ActiveCell.Offset(0, 4) = ComboBox1.Value
ActiveCell.Offset(0, 5) = TextBox5.Value
ActiveCell.Offset(0, 6) = TextBox3.Value
ActiveCell.Offset(0, 7) = TextBox4.Value
ActiveCell.Offset(0, 8) = ComboBox2.Value
ActiveCell.Offset(0, 9) = ComboBox3.Value
ActiveCell.Offset(0, 10) = TextBox6.Value





'clear the data
Me.txtdate.Value = ""
Me.cmbMgr.Value = ""
Me.cmbAdvocate.Value = ""
Me.ComboBox1.Value = ""
Me.TextBox5.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.ComboBox2.Value = ""
Me.ComboBox3.Value = ""
Me.TextBox6.Value = ""

Windows("Car Park v2.xls").Activate
ActiveWindow.Close (True)
Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

MsgBox "Your Car Park has been submitted"
Unload Me
End If


End If
End If
End If
End If
End If
End If
End If
End Sub
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
Try changing this
Code:
    Set ws = Worksheets("Sheet1")
    ActiveWorkbook.Sheets("Sheet1").Activate
    ActiveSheet.AutoFilterMode = False
    Range("A1").Select
    Do
        If IsEmpty(ActiveCell) = False Then
            ActiveCell.Offset(1, 0).Select
        End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell = txtdate
    ActiveCell.Offset(0, 1) = txtdate.Value
    ActiveCell.Offset(0, 2) = cmbMgr.Value
    ActiveCell.Offset(0, 3) = cmbAdvocate.Value
    ActiveCell.Offset(0, 4) = ComboBox1.Value
    ActiveCell.Offset(0, 5) = TextBox5.Value
    ActiveCell.Offset(0, 6) = TextBox3.Value
    ActiveCell.Offset(0, 7) = TextBox4.Value
    ActiveCell.Offset(0, 8) = ComboBox2.Value
    ActiveCell.Offset(0, 9) = ComboBox3.Value
    ActiveCell.Offset(0, 10) = TextBox6.Value

to this:
Code:
    Set ws = Worksheets(cmbMgr.Value)
    ws.AutoFilterMode = False
    ws.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 10).Value = _
    Array(txtdate.Value, cmbMgr.Value, cmbAdvocate.Value, ComboBox1.Value, TextBox5.Value, _
          TextBox3.Value, TextBox4.Value, ComboBox2.Value, ComboBox3.Value, TextBox6.Value)
 

gmazza76

Well-known Member
Joined
Mar 19, 2011
Messages
628
Office Version
  1. 365
Platform
  1. Windows
Sorry,
I am a novice with VBA.
Would this reference the info in cmbmgr ( managers name ) and then place it on the sheet in the destination file with the same managers name?
Cheers
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
It uses the sheet with the name in cmbMgr instead of Sheet1.
 

gmazza76

Well-known Member
Joined
Mar 19, 2011
Messages
628
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Good Afternoon,

Sorry it has taken me so long but i have used the VBA as above but i am getting an error as follows

Compile error:

Invalid or unqalified reference!

Any idea how i sort this

Thanks
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
Maybe posting your code and explaining what line gives the error would be a good place to start.
 

gmazza76

Well-known Member
Joined
Mar 19, 2011
Messages
628
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Sorry,

This is the VBA i am using .Rows. below is giving the error above

Private Sub cmdsubmit_Click()
If Me.txtdate.Value = "" Then
MsgBox "Please complete todays date"
Else
If Me.cmbMgr.Value = "" Then
MsgBox "You need to choose your TM name before you can raise a Car Park Query"
Else
If Me.cmbAdvocate.Value = "" Then
MsgBox "You need to complete the customer profile number before you can raise a Car Park Query"
Else
If Me.TextBox5.Value = "" Then
MsgBox "You need to complete the account number"
Else
If Me.TextBox3.Value = "" Then
MsgBox "You need to complete the customer name"
Else
If Me.ComboBox3.Value = "" Then
MsgBox "You need to complete your question catogery"
Else
If Me.TextBox6.Value = "" Then
MsgBox "You need to complete your question"
Else

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\Users\MAZZA\Documents\Gavin\Car Park\Data.xls"

Dim myBook As Workbook

On Error Resume Next
Set myBook = Application.Workbooks("Data.xls")
On Error GoTo 0

If myBook.ReadOnly Then
MsgBox "This file is being used by someone else please try again in a minute"
ActiveWorkbook.Close False
Else

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(cmbMgr.Value)
ws.AutoFilterMode = False
ws.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 10).Value = _
Array(txtdate.Value, cmbMgr.Value, cmbAdvocate.Value, ComboBox1.Value, TextBox5.Value, _
TextBox3.Value, TextBox4.Value, ComboBox2.Value, ComboBox3.Value, TextBox6.Value)

'clear the data
Me.txtdate.Value = ""
Me.cmbMgr.Value = ""
Me.cmbAdvocate.Value = ""
Me.ComboBox1.Value = ""
Me.TextBox5.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.ComboBox2.Value = ""
Me.ComboBox3.Value = ""
Me.TextBox6.Value = ""

Windows("Data.xls").Activate
ActiveWindow.Close (True)
Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

MsgBox "Your Car Park has been submitted"
Unload Me
End If


End If
End If
End If
End If
End If
End If
End If
End Sub
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
Code:
ws.Cells([COLOR=red][B]ws[/B].Rows[/COLOR].Count, "A").End(xlUp).Offset(1).Resize(, 10).Value = ...
 

Watch MrExcel Video

Forum statistics

Threads
1,122,491
Messages
5,596,477
Members
414,070
Latest member
DuncanLucas

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
Top