Search code examples
excelvbauntil-loop

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

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.
The code is only returning the last item in the submission form rather than each of the line items.

How can I have each line entry transferred to the database.

Image of code and form
enter image description here

'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