Input Box Column and Row Offse

[wyh]

I can't for the life of me figure out how to adjust my code to offset the location of where the answer to my second input box question goes. How my macro is supposed to work. . . if A4 (for example) is my active cell and where the macro starts, that's where I want the answer to the very first question to go. Then, when the second question is asked I want that answer to go to in column c of the same row. After the two questions are asked, I want to populate information for the next row (columns a and c again). When I'm done entering information I just hit enter and the macro stops.

However, what happens is that the answers to the questions only post to the first column no matter what I change the "r" values to.

Sub infoEntry()
Set c = ActiveCell
 
For r = 0 To 1
For s = 0 To 4
 
val1 = InputBox("Enter item 1:", "Quantity?")

If val1 = "" Then
Exit Sub
Else
c.Offset(s, r).Value = val1
End If
 
Next s
Next r
 
End Sub

What happens:

What I'm trying to accomplish:

For the description, I've got that covered with a vlookup formula so that doesn't need to be addressed in the code at all.

Thank you in advance for your time : )

 

[Joe4]

Here is one way:

Sub infoEntry()

    Dim r As Long
    Dim c As Long
    Dim val1 As String
    Dim ic As Long
    
'   Get active row and column
    r = ActiveCell.Row
    c = ActiveCell.Column
'   Set initial column
    ic = c
    
'   Start loop
    Do
'       Ask for input
        val1 = InputBox("Enter item 1:", "Quantity?")
'       Populate cell
        If val1 = "" Then
            Exit Sub
        Else
            Cells(r, c) = val1
        End If
'       Increment rows and columns
        If c = ic Then
            c = c + 2
        Else
            r = r + 1
            c = ic
        End If
    Loop
 
End Sub

 

[wyh]

Here is one way:

Sub infoEntry()

    Dim r As Long
    Dim c As Long
    Dim val1 As String
    Dim ic As Long
   
'   Get active row and column
    r = ActiveCell.Row
    c = ActiveCell.Column
'   Set initial column
    ic = c
   
'   Start loop
    Do
'       Ask for input
        val1 = InputBox("Enter item 1:", "Quantity?")
'       Populate cell
        If val1 = "" Then
            Exit Sub
        Else
            Cells(r, c) = val1
        End If
'       Increment rows and columns
        If c = ic Then
            c = c + 2
        Else
            r = r + 1
            c = ic
        End If
    Loop
 
End Sub

Works like a charm! Thank you so much for your help

 

[Joe4]

You are welcome!

Hopefully my logic makes sense (I tried adding some documentation to it to help explain it).
If you have any questions about any part, please do not hesitate to ask.