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"
CodePudding user response:
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