Why is my Do Until Loop only printing the last value in the loop? Excel VBA

May 9, 2022

I am writing an Excel VBA macro for a submission form. My goal is to hit the submit button and have the entered information sent to the database sheet "shTaskDB". The list has 15 available lines, but it is likely that not all these lines will be filled out.
I created a Do Until Loop to transfer entered data until the Description field is blank.
This is working, but the problem is that the code is only returning the last item in the submission form rather than each of the line items.
Any help on how I can have each line entry transferred to the database or how I can clean up the code would be appreciated.
Image of code and form

Code:
‘Begin code for Task Recording’
Dim shTaskDB As Worksheet
Set shTaskDB = ThisWorkbook.Sheets("Task DB")

Dim TaskCurrentRow As Integer
TaskCurrentRow = shTaskDB.Range("A" & Application.Rows.Count).End(xlUp).row + 1

With shTaskDB

  shPMPlan.Range("L4").Select
  ' Set Do loop to stop when an empty cell is reached.
  'Do Until IsEmpty(ActiveCell) = True
  Do Until ActiveCell = ""
     .Cells(TaskCurrentRow, 1) = shPMPlan.Range("C4")
     .Cells(TaskCurrentRow, 2) = shPMPlan.Cells(ActiveCell.row,"K")
     .Cells(TaskCurrentRow, 3) = shPMPlan.Cells(ActiveCell.row,"L")
     .Cells(TaskCurrentRow, 4) = shPMPlan.Cells(ActiveCell.row,"M")
     .Cells(TaskCurrentRow, 5) = shPMPlan.Cells(ActiveCell.row,"N")
     .Cells(TaskCurrentRow, 6) = shPMPlan.Cells(ActiveCell.row,"O")
     .Cells(TaskCurrentRow, 7) = shPMPlan.Cells(ActiveCell.row,"P")
    
    ActiveCell.Offset(1, 0).Select
  Loop

End With

MsgBox "Project Plan Recorded"

>Solution :

Your code reads row by row from shPMPlan but only ever writes to a single row TaskCurrentRow in sheet shTaskDB. SO your loop works fine, but only the last value from shPMPlan get preserved as each iteration overwrites the previous.

Consider a pattern like the following instead.

Do Until ActiveCell = ""
   
    'Write to TaskCurrentRow + a row offset that we will increment each loop
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 1) = shPMPlan.Range("C4")
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 2) = shPMPlan.Cells(ActiveCell.row,"K")
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 3) = shPMPlan.Cells(ActiveCell.row,"L")
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 4) = shPMPlan.Cells(ActiveCell.row,"M")
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 5) = shPMPlan.Cells(ActiveCell.row,"N")
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 6) = shPMPlan.Cells(ActiveCell.row,"O")
    .Cells(TaskCurrentRow + TaskCurrentRowOffset, 7) = shPMPlan.Cells(ActiveCell.row,"P")

    ActiveCell.Offset(1, 0).Select
    
    'Increment the target row offset for next iteration
    TaskCurrentRowOffset = 1 + TaskCurrentRowOffset
Loop