Help modifying InputBox code to work with 2 Ranges

[grady121]

Not having used an InputBox before, I have been given a code that uses one to add players scores into a single Range (Range 1).

The List of players names, starting at ("B10") and downwards, are presented one at a time into the InputBox with the scores entered into the corresponding cells starting at ("J10") downwards until the names stop. There may be Blanks involved.

What I would like to do is fill in another range (Range 2) starting at ("AK10") downwards at the same time as Range 1 is filled in.

Can anyone modify my existing part of code below, to achieve my aim.

 Dim ListRow As Integer, ListColumn As Integer, NewDataColumn As Integer
 Dim MyNewData As String
 Dim iRet As Integer
 
 MyNewData = "x"    ' Dummy value to keep loop alive
 
    Do Until MyNewData = ""
    ActiveWindow.ScrollRow = 9
 
    ListRow = 10: ListColumn = 2: NewDataColumn = 10
While Sheets(1).Cells(ListRow, ListColumn) <> ""
     MyNewData = InputBox("Enter the Details for:- " & vbNewLine & vbNewLine & Sheets(1).Cells(ListRow, ListColumn), _
                 "Add Scores", Sheets(1).Cells(ListRow, NewDataColumn)) 'Get input
     If MyNewData <> "" Then Sheets(1).Cells(ListRow, NewDataColumn) = MyNewData  'If input is not empty, use the input
     ListRow = ListRow + 1
   
Wend

' On to the next part of code

Thanks in advance.

 

[p45cal]

if you want the same value in AK as in B then:

Dim ListRow As Integer, ListColumn As Integer, NewDataColumn As Integer
Dim MyNewData As String
Dim iRet As Integer

MyNewData = "x"    ' Dummy value to keep loop alive

Do Until MyNewData = ""
    ActiveWindow.ScrollRow = 9

    ListRow = 10: ListColumn = 2: NewDataColumn = 10[COLOR=Red]: NewDataColumn2 = 37[/COLOR]
    While ActiveSheet.Cells(ListRow, ListColumn) <> ""
        MyNewData = InputBox("Enter the Details for:- " & vbNewLine & vbNewLine & ActiveSheet.Cells(ListRow, ListColumn), _
                             "Add Scores", ActiveSheet.Cells(ListRow, NewDataColumn))    'Get input
        If MyNewData <> "" Then [COLOR=Red]'new line here[/COLOR]
            ActiveSheet.Cells(ListRow, NewDataColumn) = MyNewData  'If input is not empty, use the input
            [COLOR=Red]ActiveSheet.Cells(ListRow, NewDataColumn[B]2[/B]) = MyNewData
        End If[/COLOR]
        ListRow = ListRow + 1
    Wend

 

[grady121]

Thanks p45cal

Works great.

I can now see the logic, I just couldn't see the wood before !

Many thanks for a quick response.