Excel input box to insert data into new excel row

[mollovg]

Hello Everyone,

I am a novice to excel and VB. I want to make a program in an excel workbook that adds new client details to the workbook with an Input Box. So far I have achievded to add new client info bu it doesnt go to the new empty row below the last one I entered and I dont know why. All I wanted to do for the moment was to have client info be entered into the workbook but since I have column description at the top as well the information would have to be entered after the 11 row. I have been going at this for days now and cant figure out how to do it tried with For Next loop to add the info and a new column but doesnt work. Any help would be greatly appreciated.

I will paste the code I have so far here:

Sub Button1_Click()
Dim emptyRow As Long
 
Dim i As Integer
Dim n As Integer
Dim m As Long
Dim a As Integer
'Make Sheet2 Active
Sheets(2).Activate
 Dim lastrow As Range
 Dim c As Integer
 Dim ClientStat As String
 Dim StrCustRef As String
 Dim StrCompName As String
 Dim ContactName As String
 Dim Telephone As Single
 Dim email As String
 Dim ContDate As Date
 Dim DateSentOffice As Date
 Dim ClientReplyDate As Date
 Dim ListSentDate As Date
 Dim orders As String
 Dim linkOrders As String
 ClientStat = "ES"
 n = ActiveCell.Row
 lastrow = ActiveCell.Rows.Count
 For i = n To lastrow
 StrCustRef = InputBox("Please enter Customer Reference")
 StrCompName = InputBox("Please Enter Company Name")
 ContactName = InputBox("Please enter the name of the person you were in contact with")
 Telephone = InputBox("Please enter client telephone Number")
 email = InputBox("Please enter client email Adress")
 ListSentDate = InputBox("Please Enter the Date the List and/or presentation were sent to the client")
 ContDate = InputBox("Please enter the date when the client replyied to the presentation")
 DateSentOffice = InputBox("Please enter the date the client request was sent to the office")
 ClientReplyDate = InputBox("Please enter the date the client replied")
 orders = InputBox("Orders Y/N")
 Sheets("Sheet2").Range("A" & i) = ClientStat
 Sheets("Sheet2").Range("B" & i) = StrCustRef
 Sheets("Sheet2").Range("C" & i) = StrCompName
 Sheets("Sheet2").Range("D" & i) = ContactName
 Sheets("Sheet2").Range("E" & i) = Telephone
 Sheets("Sheet2").Range("F" & i) = email
 Sheets("Sheet2").Range("G" & i) = ContDate
 Sheets("Sheet2").Range("H" & i) = DateSentOffice
 Sheets("Sheet2").Range("I" & i) = ClientReplyDate
 Sheets("Sheet2").Range("J" & i) = ListSentDate
 Next i
End Sub

It just doesnt go onto a new row when I enter new client information it just replaces the old one on top. I have another code as well:

Sub Button1_Click()
    Dim emptyRow As Long
 
    Dim i As Integer
    Dim n As Integer
    Dim m As Long
    Dim a As Integer
     'Make Sheet2 Active
    Sheets(2).Activate
    Dim lastrow
    Dim c As Integer
    Dim ClientStat As String
    Dim StrCustRef As String
    Dim StrCompName As String
    Dim ContactName As String
    Dim Telephone As Single
    Dim email As String
    Dim ContDate As Date
    Dim DateSentOffice As Date
    Dim ClientReplyDate As Date
    Dim ListSentDate As Date
    Dim orders As String
    Dim linkOrders As String
    ClientStat = "ES"
    With Worksheets("Sheet2")
 
        lastrow = .Range("A1").End(xlDown).Row
 
        StrCustRef = InputBox("Please enter Customer Reference")
        StrCompName = InputBox("Please Enter Company Name")
        ContactName = InputBox("Please enter the name of the person you were in contact with")
        Telephone = InputBox("Please enter client telephone Number")
        email = InputBox("Please enter client email Adress")
        ListSentDate = InputBox("Please Enter the Date the List and/or presentation were sent to the client")
        ContDate = InputBox("Please enter the date when the client replyied to the presentation")
        DateSentOffice = InputBox("Please enter the date the client request was sent to the office")
        ClientReplyDate = InputBox("Please enter the date the client replied")
        orders = InputBox("Orders Y/N")
        .Range("A" & lastrow) = ClientStat
        .Range("B" & lastrow) = StrCustRef
        .Range("C" & lastrow) = StrCompName
        .Range("D" & lastrow) = ContactName
        .Range("E" & lastrow) = Telephone
        .Range("F" & lastrow) = email
        .Range("G" & lastrow) = ContDate
        .Range("H" & lastrow) = DateSentOffice
        .Range("I" & lastrow) = ClientReplyDate
        .Range("J" & lastrow) = ListSentDate
        .Range("K" & lastrow) = orders
    End With
End Sub

Any help would be greatly appreciated.

Thanks

[ivansyah]

Just Use Cells and manual looping, coz Range doesn't automatic

Dim i As Long, theCell As Long
 
For i = 11 To 100
    If IsEmpty(ActiveSheet.Cells(i, 1).Value) = True Then
        theCell = i
        Exit For
    End If
Next
 ActiveSheet.Cells(theCell, 1).Value = InputBox("Please enter Customer Reference", "Row " & theCell)
 ActiveSheet.Cells(theCell, 2).Value = InputBox("Please enter the date the client replied", "Row " & theCell)
 

[Rodney Roe]

Or you could do something like this

[A1].end(xldown).offset(1,0) = ClientStat
[B1].end(xldown).offset(1,0) = StrCustRef
 

etc...

or

[A1].end(xldown).offset(1,2) = StrCustRef
[A1].end(xldown).offset(1,1) = StrCustRef
[A1].end(xldown).offset(1,0) = ClientStat
 

etc...
that should get you to the last row and you don't have to do any loops. Assuming that there aren't any blank cells between A1 and the end cell.