How to insert data from multiple arrays from an Excel form to database?

Question

I have a manually built form that looks approximately like this in Excel sheet VolunteerForm:

and the database in sheet VolunteerData linked to the form:

I managed to link the first part of the information (Col A to F in the database) but not the lower half of the form.

This is what I have done so far (note that I built the code but can't figure out how to modify them to give the result I want, since running the code gave me an error).

Here's my code:

Sub Submit_VolunteerForm()

   Dim lr As Long, ws As Worksheet
   Dim arr As Variant, i As Long

    With Worksheets("VolunteerForm")
       lr = .Cells(12, "D").End(xlUp).Row - 6
       ReDim arr(1 To lr, 1 To 6)
       For i = LBound(arr, 1) To UBound(arr, 1)
        arr(i, 1) = .Cells(4, "D").Value         ' Fixed Col = Date Form sent
        arr(i, 2) = .Cells(i + 6, "E").Value     ' Name
        arr(i, 3) = .Cells(i + 6, "F").Value     ' Dob
        arr(i, 4) = .Cells(i + 6, "G").Value     ' birthplace
        arr(i, 5) = .Cells(i + 6, "H").Value     ' address
        arr(i, 6) = .Cells(i + 6, "I").Value     ' phone #

     Next i
    End With

    With Worksheets("VolunteerData")
       lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
       .Cells(lr, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With    

  With Worksheets("VolunteerData")
      lr = .Range("G" & .Rows.Count).End(xlUp).Row + 1
      .Cells(lr, "G").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
   End With

   With Worksheets("VolunteerForm")
      lr = .Cells(21, "D").End(xlUp).Row - 15
      ReDim arr(1 To lr, 1 To 6)
     For i = LBound(arr, 1) To UBound(arr, 1)
        arr(i, 1) = .Cells(i + 15, "J").Value
        arr(i, 2) = .Cells(i + 15, "K").Value
        arr(i, 3) = .Cells(i + 15, "L").Value
        arr(i, 4) = .Cells(i + 15, "M").Value
        arr(i, 5) = .Cells(i + 15, "N").Value

       Next i
    End With

  End Sub

Thanks!

What is the error? At which line? Have you tried debugging your code (analystcave.com/how-to-debug-vba)? — Máté Juhász
– Máté Juhász, Commented Sep 12, 2018 at 7:56
@MátéJuhász, thanks for the comment, I have revised my question above. I built the code and the reason I didn't post the lower half solution is because it doesn't work. I added the complete code I am currently struggling with in the message now — user71812
– user71812, Commented Sep 12, 2018 at 7:56

QHarr · Accepted Answer · 2018-09-12 08:13:54Z

1

You should use a userform/excel data entry form or Access Database.

However, assuming your form always has the same number of rows and is ordered the same in top and bottom tables you can use something like:

Option Explicit
Public Sub TransferData()

    Dim lastRow As Long, nextRow As Long, dateFilled As Range
    Dim wsDest As Worksheet, wsSource As Worksheet
    Dim formData1 As Range, formData2 As Range

    Set wsDest = ThisWorkbook.Worksheets("VolunteerData")
    Set wsSource = ThisWorkbook.Worksheets("VolunteerForm")
    Set dateFilled = wsSource.Range("D4")
    Set formData1 = wsSource.Range("D7:I11")
    Set formData2 = wsSource.Range("E16:I20")
    Application.ScreenUpdating = False

    With wsDest
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    nextRow = lastRow + 1

    With formData1
        wsDest.Range("A" & nextRow).Resize(.Rows.Count, 1).Value = dateFilled.Value
        wsDest.Range("B" & nextRow).Resize(.Rows.Count, .Columns.Count).Value = formData1.Value
        wsDest.Range("H" & nextRow).Resize(.Rows.Count, .Columns.Count - 1).Value = formData2.Value
    End With

    ''potential housekeeping tasks to clear form?
    formData1.Clear
    formData2.Clear
    formData2.Offset(, -1).Clear
    dateFilled.Clear

    Application.ScreenUpdating = True
End Sub

edited Sep 12, 2018 at 8:13

answered Sep 12, 2018 at 7:55

QHarr

84.5k14 gold badges58 silver badges105 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

user71812 Over a year ago

Thanks a lot!!! that works perfect for me, but would you mind explain a bit more about this line? Select Case lastRow Case 2 nextRow = 2 Case Else nextRow = lastRow + 1 End Select

QHarr Over a year ago

It might be redundant to be honest. Let me check. Yeah, it is in this case. I will remove.

user71812 Over a year ago

Haha okay, thanks a lot QHarr for your help. Really appreciate your help, thank you so much again! Have an awesome day!

user71812 Over a year ago

Hi QHarr, do you by any chance know how to modify the code to stop when it encounters a blank cell? Right now the code fills all the way down until the end of rowcount, even when the cells are blank. At the example above, let's say I have only 3 rows with data, but the code fills all 5 rows. Thanks!

QHarr Over a year ago

.Cells(1, "A").End(xDown).Row ? Danger is you could end up at bottom of sheet if column empty.

|

Collectives™ on Stack Overflow

How to insert data from multiple arrays from an Excel form to database?

1 Answer 1

6 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

6 Comments

Your Answer

Sign up or log in

Post as a guest

Related