Copying data from a data entry form to specific cells on another sheet based on 'category' without overwriting existing data

cteooo

New Member
Joined
Oct 18, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello,

I've made a data entry form and would like to automate the entry process using VBA when I click 'Submit'. I would like to copy values from the entry form to certain cells/columns to another sheet (it is a master data log) with existing data without overwriting them. However, it gets a little complicated as I have multiple master log sheets for different groups of people which is dependent on the category.

I have a code ready but it overwrites the existing data in the respective master data logs. The transfer of data must start below any existing data that is there. I would appreciate any guidance on how to tweak it to prevent this. Below is the code and a screenshot of my form and a sample master log.

Thank you so much!!

VBA Code:
Option Explicit

Sub Reset_Form()

    Dim iMessage As VbMsgBoxResult
  
    iMessage = MsgBox("Do you want to reset this form?", vbYesNo + vbQuestion, "Reset Confirmation")

    If iMessage = vbNo Then Exit Sub
  
    ThisWorkbook.Sheets("Form").Range("I10,I12,I14,I16,I18,I20,I22,I24,I26,I28,I32,I36,I38,I40,I44,I46,I48,I50,I54,I56,I58,I60,I64,I66,I68,I70,I72,I74,I78,I80,I82,I84,I88").Value = ""
  

End Sub

Sub Submit_Details()

    Dim shCategory As Worksheet
    Dim shForm As Worksheet
  
    Dim iCurrentRow As Integer
  
    Dim sCategoryName As String
  
    Set shForm = ThisWorkbook.Sheets("Form")
  
    sCategoryName = shForm.Range("I18").Value
  
    Set shCategory = ThisWorkbook.Sheets(sCategoryName)
  
    iCurrentRow = shCategory.Range("A" & Application.Rows.Count).End(xlUp).Row + 1
  
    With shCategory
  
      
      
        .Cells(iCurrentRow, 2) = shForm.Range("I10")
      
        .Cells(iCurrentRow, 3) = shForm.Range("I12")
      
        .Cells(iCurrentRow, 4) = shForm.Range("I14")
      
        .Cells(iCurrentRow, 6) = shForm.Range("I16")
      
        .Cells(iCurrentRow, 7) = shForm.Range("I18")
      
        .Cells(iCurrentRow, 8) = shForm.Range("I20")
      
        .Cells(iCurrentRow, 9) = shForm.Range("I22")
      
        .Cells(iCurrentRow, 10) = shForm.Range("I24")
      
        .Cells(iCurrentRow, 11) = shForm.Range("I26")
      
        .Cells(iCurrentRow, 12) = shForm.Range("I28")
      
        .Cells(iCurrentRow, 13) = shForm.Range("I32")
      
        .Cells(iCurrentRow, 14) = shForm.Range("I36")
      
        .Cells(iCurrentRow, 15) = shForm.Range("I38")
      
        .Cells(iCurrentRow, 16) = shForm.Range("I40")
      
        .Cells(iCurrentRow, 17) = shForm.Range("I44")
      
        .Cells(iCurrentRow, 18) = shForm.Range("I46")
      
        .Cells(iCurrentRow, 19) = shForm.Range("I48")
      
        .Cells(iCurrentRow, 20) = shForm.Range("I50")
      
        .Cells(iCurrentRow, 21) = shForm.Range("I54")
      
        .Cells(iCurrentRow, 22) = shForm.Range("I56")
      
        .Cells(iCurrentRow, 23) = shForm.Range("I58")
      
        .Cells(iCurrentRow, 24) = shForm.Range("II60")
      
        .Cells(iCurrentRow, 25) = shForm.Range("I64")
      
        .Cells(iCurrentRow, 26) = shForm.Range("I66")
      
        .Cells(iCurrentRow, 27) = shForm.Range("I68")
      
        .Cells(iCurrentRow, 28) = shForm.Range("I70")
      
        .Cells(iCurrentRow, 29) = shForm.Range("I72")
      
        .Cells(iCurrentRow, 30) = shForm.Range("I74")
      
        .Cells(iCurrentRow, 31) = shForm.Range("I78")
      
        .Cells(iCurrentRow, 32) = shForm.Range("I80")
             
        .Cells(iCurrentRow, 37) = shForm.Range("I82")
      
        .Cells(iCurrentRow, 40) = shForm.Range("I84")
      
        .Cells(iCurrentRow, 41) = shForm.Range("I88")
      
  
    End With
  
    shForm.Range("I10,I12,I14,I16,I18,I20,I22,I24,I26,I28,I32,I36,I38,I40,I44,I46,I48,I50,I54,I56,I58,I60,I64,I66,I68,I70,I72,I74,I78,I80,I82,I84,I88").Value = ""
  
    MsgBox "Data submitted successfully!"
  


End Sub





Form.PNG


Data.PNG
 
Last edited by a moderator:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Hi

try changing this from

VBA Code:
iCurrentRow = shCategory.Range("A" & Application.Rows.Count).End(xlUp).Row + 1

to

VBA Code:
iCurrentRow = shCategory.Range("B" & Application.Rows.Count).End(xlUp).Row + 1

Because I can only see you inputing new data into column B?

dave
 
Upvote 0
Hi

try changing this from

VBA Code:
iCurrentRow = shCategory.Range("A" & Application.Rows.Count).End(xlUp).Row + 1

to

VBA Code:
iCurrentRow = shCategory.Range("B" & Application.Rows.Count).End(xlUp).Row + 1

Because I can only see you inputing new data into column B?

dave
Hi Dave,

Thank you so much for the tip! It works great now!
 
Upvote 0
Your welcome.

Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,214,986
Messages
6,122,611
Members
449,090
Latest member
vivek chauhan

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