Dim cn As Object, rs As ADODB.Recordset
Dim strMessageType As String
Dim datMessageTime As Date
Dim intMessageCount As Integer
Dim strTime As String
Dim i As Integer
Dim j As Integer
Dim ID As Integer


Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= C:\db1.mdb"
Set rs = New ADODB.Recordset
rs.Open "Table1", cn, adOpenKeyset, adLockOptimistic

Sheets("sheet1").Select
Range("A1").Select
Selection.End(xlToRight).Select

j = ActiveCell.Column

[color="red"]  strMessageType = Range("C1").Value[/color]  The range "C1" I want to increment until 'j'
i = 1

strTime = "A1"
ID = 2
With rs
    Do Until i = 3626
        .AddNew
        !ID = ID
        !MessageType = strMessageType
        !MessageTime = Range(strTime).Offset(i, 0)
        !MessageCount = Range(strTime).Offset(i, 1)
        .Update
        i = i + 1
    Loop
End With


End Sub

Dim cn As Object, rs As ADODB.Recordset
Dim strMessageType As String
Dim datMessageTime As Date
Dim intMessageCount As Integer
Dim strRange As String
Dim i, j, k, l As Integer
Dim ID As Integer
Dim intCol As Integer
Dim strHeader As String
Dim wks As String

'Setup a db connection
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= C:\db1.mdb"
Set rs = New ADODB.Recordset
rs.Open "Table1", cn, adOpenKeyset, adLockOptimistic
wks = InputBox("What's the name of the worksheet?")
'Find last column

Sheets(wks).Select
Range("A1").Select
Selection.End(xlToRight).Select
j = ActiveCell.Column

Range("A1").Select
Selection.End(xlDown).Select
k = ActiveCell.Row

'Loop columns
strHeader = Range("A1").Address(False, False)

For intCol = 2 To j
strHeader = Range(strHeader).Offset(0, 1).Address

strMessageType = Range(strHeader).Value
i = 1

strRange = "A1"
ID = intCol
'Loop rows
With rs
    Do Until i = k
    'Write data
        .AddNew
        !ID = ID
        !MessageType = strMessageType
        !MessageTime = Range(strRange).Offset(i, 0)
        !MessageCount = Range(strRange).Offset(i, 1)
        .Update
        i = i + 1
    Loop
End With

Next intCol