Create Loop for each row in a column

[smartpat19]

I have the current macro (Code below) that adds one record to an access database which works great. How do I create a loop that would insert all 500 rows and stops at the next blank cell?

Or is there another option I should be looking at to insert multiple rows into access?

Sub Add_Record()


Application.ScreenUpdating = False


Dim db As database
Dim rs As DAO.Recordset


Set db = DAO.OpenDatabase("M:\Access\Development Team.accdb")
Set rs = db.OpenRecordset("Cost Schedule", dbOpenTable)






rs.AddNew
rs.Fields("Report_Name") = Range("A2").Value
rs.Fields("Project_Number") = Range("B2").Value
rs.Fields("Cost Month") = Range("C2").Value
rs.Fields("Acquisition Cost") = Range("D2").Value
rs.Fields("Hard Cost") = Range("E2").Value
rs.Update


rs.Close
db.Close


Application.ScreenUpdating = True




End Sub

Thank you

 

[jmacleary]

Hi there. This is completely untested, but should work:

Sub Add_Record()


Application.ScreenUpdating = False


Dim db As database
Dim rs As DAO.Recordset


Set db = DAO.OpenDatabase("M:\Access\Development Team.accdb")
Set rs = db.OpenRecordset("Cost Schedule", dbOpenTable)

Dim LastRow As Long
Dim ThisRow As Long
' column A assumed to look for blanks

LastRow = Range("A65536").End(xlUp).Row
' works from row 2 to the last row with data in column A
For ThisRow = 2 To FromRow


    rs.AddNew
    rs.Fields("Report_Name") = Range("A" & ThisRow).Value
    rs.Fields("Project_Number") = Range("B" & ThisRow).Value
    rs.Fields("Cost Month") = Range("C" & ThisRow).Value
    rs.Fields("Acquisition Cost") = Range("D" & ThisRow).Value
    rs.Fields("Hard Cost") = Range("E" & ThisRow).Value
    rs.Update

Next ThisRow

rs.Close
db.Close


Application.ScreenUpdating = True




End Sub