Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Data Entry with Save Macro



I am trying to create a form and a simple save macro to copy the data from the form to a data sheet.  It works for a few of the fields on the form but then it just stops.  I don't get an error message. Not all the data from the form is copied to the datasheet. I cannot figure out what I have done wrong.  Attached is a copy of the broken file. Thanks in advance for your help!



Selected Answer

Hi Kg4u22 and welcome to the Forum.

In the attached revised file, all data is copied from Input worksheet to Data. I've also made it easier to read by using a With/ End With blocks (e.g. to prevent repeating Sheets("Input") 50 odd times!) See the Microsoft guidance here With statement

The problems with your macro were:

  1. On the Input sheet (Rating  and E30) were blank- added in red
  2. When copying the saved data, the code matched until this point:
    .Cells(NextEmptyRow, 15).Value = inputCitizenComments
    .Cells(NextEmptyRow, 16).Value = BenefitPoints

but now reads:

    .Cells(NextEmptyRow, 15).Value = inputCitizenComments
    ' after this point, variables don't match saved items (now corrected)
    .Cells(NextEmptyRow, 16).Value = inputBenefitPoints

i.e. adding (the missing) input to start of the names of saved items.


There were other minor issues (identified in bold in the revised coide below):

Sub SaveData()

' Get the data to save
With Sheets("Input")
    inputAgency = Sheets("Input").Range("B6").Value
    inputCallDate = .Range("B7").Value
    inputReviewer = .Range("B8").Value
    inputAgent = .Range("F6").Value
    inputPolicyNo = .Range("F7").Value
    inputReviewDate = .Range("F8").Value

    inputRecordedCallPoints = .Range("C12").Value
    inputRecordedCallScore = .Range("D12").Value
    inputRecordedCallComments = .Range("E12").Value

    inputProdDescPoints = .Range("C13").Value
    inputProdDescScore = .Range("D13").Value
    inputProdDescComments = .Range("E13").Value

    inputCitizenPoints = .Range("C16").Value
    inputCitizenScore = .Range("D16").Value
    inputCitizenComments = .Range("E16").Value

    inputBenefitPoints = .Range("C17").Value
    inputBenefitScore = .Range("D17").Value
    inputBenefitComments = .Range("E17").Value

    inputBeneficiaryPoints = .Range("C18").Value
    inputBeneficiaryScore = .Range("D18").Value
    inputBeneficiaryComments = .Range("E18").Value

    inputOtherCoveragePoints = .Range("C19").Value
    inputOtherCoverageScore = .Range("D19").Value
    inputOtherCoverageComments = .Range("E19").Value

    inputReplacingPoints = .Range("C20").Value
    inputReplacingScore = .Range("D20").Value
    inputReplacingComments = .Range("E20").Value

    inputAcknowledgementPoints = .Range("C21").Value
    inputAcknowledgementScore = .Range("D21").Value
    inputAcknowledgementComments = .Range("E21").Value

    inputNIPPoints = .Range("C22").Value
    inputNIPScore = .Range("D22").Value
    inputNIPComments = .Range("E22").Value

    inputStatePoints = .Range("C23").Value
    inputStateScore = .Range("D23").Value
    inputStateComments = .Range("E23").Value

    inputNYPoints = .Range("C24").Value
    inputNYScore = .Range("D24").Value
    inputNYComments = .Range("E24").Value

    inputPaymentPoints = .Range("C25").Value
    inputPaymentScore = .Range("D25").Value
    inputPaymentComments = .Range("E25").Value

    inputQuotePoints = .Range("C27").Value
    inputQuoteScore = .Range("D27").Value
    'this read (repeated) inputQuoteScore
    inputQuoteComments = .Range("E27").Value

    inputProfessionalPoints = .Range("C28").Value
    inputProfessionalScore = .Range("D28").Value
    inputProfessionalComments = .Range("E28").Value

    inputTotalScore = .Range("C30").Value
    inputTotalPoints = .Range("D30").Value
     ' had no value on form
    inputRating = .Range("E30").Value

    inputWho = .Range("B32").Value
    inputWhat = .Range("B33").Value
    inputByWhen = .Range("B34").Value
End With

With Sheets("Data")
    ' determine next empty row
    NextEmptyRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1

    ' Save the data

    .Cells(NextEmptyRow, 1).Value = inputAgency
    .Cells(NextEmptyRow, 2).Value = inputCallDate
    .Cells(NextEmptyRow, 3).Value = inputReviewer
    .Cells(NextEmptyRow, 4).Value = inputAgent
    .Cells(NextEmptyRow, 5).Value = inputPolicyNo
    .Cells(NextEmptyRow, 6).Value = inputReviewDate

    .Cells(NextEmptyRow, 7).Value = inputRecordedCallPoints
    .Cells(NextEmptyRow, 8).Value = inputRecordedCallScore
    .Cells(NextEmptyRow, 9).Value = inputRecordedCallComments

    .Cells(NextEmptyRow, 10).Value = inputProdDescPoints
    .Cells(NextEmptyRow, 11).Value = inputProdDescScore
    .Cells(NextEmptyRow, 12).Value = inputProdDescComments

    .Cells(NextEmptyRow, 13).Value = inputCitizenPoints
    .Cells(NextEmptyRow, 14).Value = inputCitizenScore
    .Cells(NextEmptyRow, 15).Value = inputCitizenComments
    ' after this point, variables don't match saved items (now corrected)
    .Cells(NextEmptyRow, 16).Value = inputBenefitPoints
    .Cells(NextEmptyRow, 17).Value = inputBenefitScore
    .Cells(NextEmptyRow, 18).Value = inputBenefitComments
    .Cells(NextEmptyRow, 19).Value = inputBeneficiaryPoints
    .Cells(NextEmptyRow, 20).Value = inputBeneficiaryScore
    .Cells(NextEmptyRow, 21).Value = inputBeneficiaryComments

    .Cells(NextEmptyRow, 22).Value = inputOtherCoveragePoints
    .Cells(NextEmptyRow, 23).Value = inputOtherCoverageScore
    .Cells(NextEmptyRow, 24).Value = inputOtherCoverageComments

    .Cells(NextEmptyRow, 25).Value = inputReplacingPoints
    .Cells(NextEmptyRow, 26).Value = inputReplacingScore
    .Cells(NextEmptyRow, 27).Value = inputReplacingComments

    .Cells(NextEmptyRow, 28).Value = inputAcknowledgementPoints
    .Cells(NextEmptyRow, 29).Value = inputAcknowledgementScore
    .Cells(NextEmptyRow, 30).Value = inputAcknowledgementComments

    .Cells(NextEmptyRow, 31).Value = inputNIPPoints
    .Cells(NextEmptyRow, 32).Value = inputNIPScore
    .Cells(NextEmptyRow, 33).Value = inputNIPComments

    .Cells(NextEmptyRow, 34).Value = inputStatePoints
    .Cells(NextEmptyRow, 35).Value = inputStateScore
    .Cells(NextEmptyRow, 36).Value = inputStateComments

    .Cells(NextEmptyRow, 37).Value = inputNYPoints
    .Cells(NextEmptyRow, 38).Value = inputNYScore
    .Cells(NextEmptyRow, 39).Value = inputNYComments
    ' this one read PaymentPints!
    .Cells(NextEmptyRow, 40).Value = inputPaymentPoints
    .Cells(NextEmptyRow, 41).Value = inputPaymentScore
    .Cells(NextEmptyRow, 42).Value = inputPaymentComments

    .Cells(NextEmptyRow, 43).Value = inputQuotePoints
    .Cells(NextEmptyRow, 44).Value = inputQuoteScore
    .Cells(NextEmptyRow, 45).Value = inputQuoteComments

    .Cells(NextEmptyRow, 46).Value = inputProfessionalPoints
    .Cells(NextEmptyRow, 47).Value = inputProfessionalScore
    .Cells(NextEmptyRow, 48).Value = inputProfessionalComments

    .Cells(NextEmptyRow, 49).Value = inputTotalScore
    .Cells(NextEmptyRow, 50).Value = inputTotalPoints
    .Cells(NextEmptyRow, 51).Value = inputRating

    .Cells(NextEmptyRow, 52).Value = inputWho
    .Cells(NextEmptyRow, 53).Value = inputWhat
    .Cells(NextEmptyRow, 54).Value = inputByWhen
End With
<< rest of "clear contents code omitted>>

Revision 16 May 2023 (promised tip for seleting original answer):

The second attached file (Book2 looping combined non-contiguous range v0_b.xlsm) has a new button on the worksheet "Input", green and labelled "Save Data". The following macro (just 11 lines plus comments)  is assigned to that and is equivalent to your very verbose macro above:

Sub SaveData2()

Dim n As Long, FormClls As Range, Ar As Range, Cll As Range, NextEmptyRow As Long

' state the contiguous areas of data on form
Set FormClls = Sheet1.Range("B6, F6,  B7, F7, B8, F8, C12:E13, C16:E25, C27:E28, C30:E30, B32:B34")

' determine next empty row
NextEmptyRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1

' reset offset counter
n = 0

' loop through each area
For Each Ar In FormClls.Areas
    ' loop through each cell in each area
    For Each Cll In Ar.Cells
        ' write to next cell along
        Sheet2.Range("A" & NextEmptyRow).Offset(0, n).Value = Cll.Value

        ' ### uncomment next line to clear each cell (once written)
        'Cll.Value = ""
        ' increment row counter
        n = n + 1
    Next Cll
Next Ar

MsgBox "Call data saved to row " & NextEmptyRow

End Sub

The bold line defines all the input cells of your form as a non-contiguous range. That is made up of several Areas defines in sequence (e.g. B6 or C16:E25) which are looped through and (inside each) each cells is looped through (left to right and down) then written to a new line usiung the Offset method. Click either button and the result is the same!

Note that there's a comment ' ### uncomment next line to clear each cell (once written) so you could clear the whole form in one line (or add a test like If n>=3 then Cll.Value = "" to clear fields beyond a point only say).

Hope this fixes your problems. (Since you selected my Answer, I've also given you the revision/ tip to reduce this code by more than 50% ).



Thanks for selecting my Answer, Kg. I'll try to post a revision later (with much shorter code doing the same thing). Interested? 
John_Ru (rep: 6172) May 16, '23 at 12:50 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login