How can I change Output(a Range Object) of an InputBox as the row changes

[anilsharaf]

I have a procedure that takes it's range from an InputBox. It does something then selects next row. But range supplied by InputBox remains the same. Is there any way to change it relative to row change.

Data is:

Y Hindi	Y Eng	Y History	Y Pol Sc	Y Geo	Y Geo Practicle	Y TotGeo	Y Evs	Y Total	Y PassFailAnnvl9thFinal	Y Percent of Marks	Y Division	Y Position in class	Y Sup Subjct_1	Y Sup Subjct_2
25	40	44	18	34	08	42	41	169	iwjd				fganh
40	61	41	47	40	08	48	41	237	mÙkh.kZ	47.4	II
25	40	44	18	34	08	42	44	169	iwjd
25	37	34	12	29	08	37	34	145	iwjd
35	21	26	09	31	08	39	26	130	vuqÙkh.kZ

<colgroup><col><col><col><col><col span="2"><col span="2"><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Code is

Sub supplemntry11thArtk_NotComplete()
'Change Starred ************** line according to NEED
'Select 1st cell of "PassOrFail" Colm
'This will work when Practicle and Project
'marks colm are also filled
'Dim AllSub()
Dim PassingMarks(), TheoryMarks(), SubNm(), SupSub(2)
PassingMarks = Array(33, 33, 33, 33, 25)
'SubNm = Array(Hindi,English,History,PolSc,Geography)
SubNm = Array("fganh", "vaxzsth", "vfrgkl", "jktuhfr", "Hkwxksy")


Dim absent As Integer
absent = 0: NoOfSubjects = 5




'*********************************
'Warning: Select First Cell of Result Colm


Response = MsgBox("Select First Cell of Result Colm", _
vbOKCancel + vbCritical + vbDefaultButton1, "Select Result Cell")

If Response = vbCancel Then
MsgBox "Programme Cancelled:Begin Again", _
vbOKOnly + vbCritical + vbInformation, _
"Programme Terminated"
Exit Sub
Else: GoTo GoAhead
End If


'*********************************
GoAhead:


Set RInput = Application.InputBox _
("Select All Subject excluding EVS", "Select Range", , , , , , 8)

x = RInput.Address(rowabsolute:=False, columnabsolute:=False, _
relativeto:=ActiveCell)
'y = Range(x)
Set AllSub = Range(x)


'For j = 1 To 10
For i = 1 To NoOfSubjects
ReDim Preserve TheoryMarks(i)
TheoryMarks(i) = AllSub(i)
Next i
'Erase TheoryMarks
'ActiveCell.Offset(1, 0).Select
'Next j






'*********************************







Do Until Selection = ""
If ActiveCell <> "iwjd" Then 'iwjd=SUPPL******************
GoTo lastline1

Else
j = 1

For i = 1 To NoOfSubjects
If TheoryMarks(i) < PassingMarks(i) _
Or TheoryMarks(i) = "abs" Then
SupSub(j) = SubNm(i)
j = j + j
End If
Next i
End If
ActiveCell.Offset(0, 4) = SupSub(1)
ActiveCell.Offset(0, 5) = SupSub(2)


lastline1:
ActiveCell.Offset(1, 0).Select
Erase SupSub
Loop



lastline2:


Exit Sub
End Sub