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:
- On the Input sheet (Rating and E30) were blank- added in red
- 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% ).