VBA - Data Table - After adding record copy template, rename and insert data

Lee Rabbit

New Member
Joined
Apr 30, 2020
Messages
43
Office Version
  1. 2010
Platform
  1. Windows
Good Day,

I am still learning but yet again, I have run into a brick wall.

I have created a VBA data entry form that is working perfectly to add the desired data into my table. The next step of my project is to take that data and create a copy of a template sheet, rename it based on a cell value in the table and insert the captured data into specific cells in the newly created worksheet.

Here is the VBA

VBA Code:
Private Sub CommandButton1_Click()

    If Me.TextBox1.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox2.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox3.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox4.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox5.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox6.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox7.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox8.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox9.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox10.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    If Me.TextBox11.Value = "" Then
    MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
    Exit Sub
    End If
    
    
'CHECK FOR DUPLICATE NAME

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA ENTRY")
Dim n As Long

    If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.TextBox1.Value) > 0 Then
    MsgBox "THIS NAME ALREADY EXISTS IN THE DATABASE - PLEASE CHOOSE ANOTHER NAME!", vbCritical
    Exit Sub
    End If
    
n = sh.Range("B" & Application.Rows.Count).End(xlUp).Row



    sh.Range("B" & n + 1).Value = Me.TextBox1.Value 'This is DRIVER NAME and will be the name of the copied TEMPLATE
    sh.Range("C" & n + 1).Value = Me.TextBox2.Value 
    sh.Range("D" & n + 1).Value = Me.TextBox3.Value 
    sh.Range("E" & n + 1).Value = Me.TextBox4.Value 
    sh.Range("F" & n + 1).Value = Me.TextBox5.Value 
    sh.Range("G" & n + 1).Value = Me.TextBox6.Value 
    sh.Range("H" & n + 1).Value = Me.TextBox7.Value 
    sh.Range("I" & n + 1).Value = Me.TextBox8.Value 
    sh.Range("J" & n + 1).Value = Me.TextBox9.Value 
    sh.Range("K" & n + 1).Value = Me.TextBox10.Value 
    sh.Range("L" & n + 1).Value = Me.TextBox11.Value
    
    

    
    Me.TextBox1 = ""
    Me.TextBox2 = ""
    Me.TextBox3 = ""
    Me.TextBox4 = ""
    Me.TextBox5 = ""
    Me.TextBox6 = ""
    Me.TextBox7 = ""
    Me.TextBox8 = ""
    Me.TextBox9 = ""
    Me.TextBox10 = ""
    Me.TextBox11 = ""
    
MsgBox "NEW DRIVER HAS BEEN ADDED", vbInformation

'At this point I want to take the inputted data and insert into defined cells on a "TEMPLATE" sheet

'To do this, I will need to:

'(1) Copy sheet named "TEMPLATE"
'(2) Rename the sheet with the cell value inserted as driver name (TextBox1)
'(3) Input recorded data from row to cells in new created sheet in this order:

'TextBox (1) =B4
'TextBox (2) =B5
'TextBox (3) =B6
'TextBox (4) =B7
'TextBox (5) =B8
'TextBox (6) =K4
'TextBox (7) =K5
'TextBox (8) =D26
'TextBox (9) =D27
'TextBox (10) =D28
'TextBox (11) =J2

I have tried many attempts but I keep running into errors.

To anyone who can help, a big thank you in advance.

Regards,
Lee
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
How about
VBA Code:
Private Sub CommandButton1_Click()
   Dim i As Long, n As Long
   Dim sh As Worksheet, Nws As Worksheet
   Dim Ary As Variant
   
   Set sh = ThisWorkbook.Sheets("DATA ENTRY")
   Ary = Array("B4", "B5", "B6", "B7", "B8", "K4", "K5", "D26", "D27", "D28", "J2")
   
   For i = 1 To 11
      If Me.Controls("TextBox" & i).Value = "" Then
         MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
         Exit Sub
      End If
   Next i

    
'CHECK FOR DUPLICATE NAME
   If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.TextBox1.Value) > 0 Then
     MsgBox "THIS NAME ALREADY EXISTS IN THE DATABASE - PLEASE CHOOSE ANOTHER NAME!", vbCritical
     Exit Sub
   End If
   
   Sheets("Template").Copy , Sheets(Sheets.Count)
   Set Nws = ActiveSheet
   Nws.Name = Me.TextBox1.Value
   
   n = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
   For i = 1 To 11
      sh.Range("A" & n).Offset(, i).Value = Me.Controls("Textbox" & i).Value
      Nws.Range(Ary(i - 1)).Value = Me.Controls("Textbox" & i).Value
      Me.Controls("textbox" & i) = ""
   Next i
   
   MsgBox "NEW DRIVER HAS BEEN ADDED", vbInformation
End Sub
 
Upvote 0
How about
VBA Code:
Private Sub CommandButton1_Click()
   Dim i As Long, n As Long
   Dim sh As Worksheet, Nws As Worksheet
   Dim Ary As Variant
  
   Set sh = ThisWorkbook.Sheets("DATA ENTRY")
   Ary = Array("B4", "B5", "B6", "B7", "B8", "K4", "K5", "D26", "D27", "D28", "J2")
  
   For i = 1 To 11
      If Me.Controls("TextBox" & i).Value = "" Then
         MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
         Exit Sub
      End If
   Next i

   
'CHECK FOR DUPLICATE NAME
   If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.TextBox1.Value) > 0 Then
     MsgBox "THIS NAME ALREADY EXISTS IN THE DATABASE - PLEASE CHOOSE ANOTHER NAME!", vbCritical
     Exit Sub
   End If
  
   Sheets("Template").Copy , Sheets(Sheets.Count)
   Set Nws = ActiveSheet
   Nws.Name = Me.TextBox1.Value
  
   n = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
   For i = 1 To 11
      sh.Range("A" & n).Offset(, i).Value = Me.Controls("Textbox" & i).Value
      Nws.Range(Ary(i - 1)).Value = Me.Controls("Textbox" & i).Value
      Me.Controls("textbox" & i) = ""
   Next i
  
   MsgBox "NEW DRIVER HAS BEEN ADDED", vbInformation
End Sub

Thank you Fluff once again for your expertise. LEGEND!!!

And once again I look at this code and how you have condensed it to my needs and once again I have learned new processes.

Where do I send the Christmas card?

Regards,
Lee
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0
How about
VBA Code:
Private Sub CommandButton1_Click()
   Dim i As Long, n As Long
   Dim sh As Worksheet, Nws As Worksheet
   Dim Ary As Variant
  
   Set sh = ThisWorkbook.Sheets("DATA ENTRY")
   Ary = Array("B4", "B5", "B6", "B7", "B8", "K4", "K5", "D26", "D27", "D28", "J2")
  
   For i = 1 To 11
      If Me.Controls("TextBox" & i).Value = "" Then
         MsgBox "PLEASE COMPLETE ALL SECTIONS", vbCritical
         Exit Sub
      End If
   Next i

   
'CHECK FOR DUPLICATE NAME
   If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.TextBox1.Value) > 0 Then
     MsgBox "THIS NAME ALREADY EXISTS IN THE DATABASE - PLEASE CHOOSE ANOTHER NAME!", vbCritical
     Exit Sub
   End If
  
   Sheets("Template").Copy , Sheets(Sheets.Count)
   Set Nws = ActiveSheet
   Nws.Name = Me.TextBox1.Value
  
   n = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
   For i = 1 To 11
      sh.Range("A" & n).Offset(, i).Value = Me.Controls("Textbox" & i).Value
      Nws.Range(Ary(i - 1)).Value = Me.Controls("Textbox" & i).Value
      Me.Controls("textbox" & i) = ""
   Next i
  
   MsgBox "NEW DRIVER HAS BEEN ADDED", vbInformation
End Sub

Hi Fluff, sorry to bother you again.

I have just noticed that I need convert all entries made in TextBox 1 to 10 in user form as upper case and TextBox 11 as lower case, regardless what they type when user submits form.

I have tried to adapt your code but can't get it to work.

Regards,
Lee
 
Upvote 0
How about
VBA Code:
   n = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
   For i = 1 To 10
      sh.Range("A" & n).Offset(, i).Value = UCase(Me.Controls("Textbox" & i).Value)
      Nws.Range(Ary(i - 1)).Value = UCase(Me.Controls("Textbox" & i).Value)
      Me.Controls("Textbox" & i) = ""
   Next i
   sh.Range("A" & n).Offset(, i).Value = LCase(Me.Controls("Textbox" & i).Value)
   Nws.Range(Ary(i - 1)).Value = LCase(Me.Controls("Textbox" & i).Value)
   Me.Controls("Textbox" & i) = ""

   MsgBox "NEW DRIVER HAS BEEN ADDED", vbInformation
 
Upvote 0
How about
VBA Code:
   n = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
   For i = 1 To 10
      sh.Range("A" & n).Offset(, i).Value = UCase(Me.Controls("Textbox" & i).Value)
      Nws.Range(Ary(i - 1)).Value = UCase(Me.Controls("Textbox" & i).Value)
      Me.Controls("Textbox" & i) = ""
   Next i
   sh.Range("A" & n).Offset(, i).Value = LCase(Me.Controls("Textbox" & i).Value)
   Nws.Range(Ary(i - 1)).Value = LCase(Me.Controls("Textbox" & i).Value)
   Me.Controls("Textbox" & i) = ""

   MsgBox "NEW DRIVER HAS BEEN ADDED", vbInformation

Works like a dream. Thanks Fluff

I was so close to executing it myself. Another lesson learned.

Regards,
Lee
 
Upvote 0
Glad to help & thanks for the feedback.
 
Upvote 0
Glad to help & thanks for the feedback.

Fluff, could the same theory be used to apply an update to an existing record?

Rather than copying the worksheet, any update would replace the values in the array of the worksheet that was initially created.

I understand that I would need to populate a ComboBox with all the names and draw the existing data into the TextBoxes (I think I know how to do that).

Not sure about the update theory of the task.

Regards,
Lee
 
Upvote 0
Fluff, could the same theory be used to apply an update to an existing record?
Yes that's possible, but you will need to start a new thread if you need help with it.
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,072
Members
448,546
Latest member
KH Consulting

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