For any distinct value, ask an input through an inputbox

Paul82

New Member
Joined
Feb 25, 2020
Messages
7
Office Version
  1. 2010
Platform
  1. Windows
Hi,

i hope someone can help me with this matter

I try to explain it very simple

My excel sheet has different values in column A, but there could be also duplicates

1582623748888.png


I want now that for every value in Column 1, vba asks me to put a value into an input box and pasts the answer in the corresponding filed(s) in column 2.

For the excel above i want that vba ask me 3 times to input a value (A, B and C) and then copies the value in the column 2

for example, It asks me one time to input a value for "A" and copy the input from inputbox in cells B2, B3 and B4

thanks in advance
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi Paul. Try this code:
VBA Code:
Sub Paul82()
    Dim Answer As String
    Dim OneRow As Long
    Dim OneValue As String
    Dim LastRow As Long
    Dim AllRows As New Scripting.Dictionary
    LastRow = Range("A65536").End(xlUp).Row

    For OneRow = 2 To LastRow
        OneValue = Cells(OneRow, 1).Value
        If AllRows.exists(OneValue) Then
            Cells(OneRow, 2).Value = AllRows(OneValue)
        Else
            Answer = InputBox("Please enter a value for " & OneValue)
            Cells(OneRow, 2).Value = Answer
            AllRows(OneValue) = Answer
        End If
    Next

End Sub
 
Upvote 0
I assume that all cells in column B are empty before procedure runs

Another option (which is less elegant than solution posted by @jmacleary)
VBA Code:
Sub GetInput()
    Dim cel As Range, cel2 As Range, lastCel As Range, v As Variant
    Application.ScreenUpdating = False
    Set lastCel = Range("A" & Rows.Count).End(xlUp)
    For Each cel In Range("A2", lastCel)
        If cel.Offset(, 1) = "" Then
            v = InputBox("Enter value for " & cel.Value, "User Input")
            For Each cel2 In Range(cel, lastCel)
                If cel2 = cel Then cel2.Offset(, 1) = v
            Next cel2
        End If
    Next cel
End Sub
 
Upvote 0
I assume that all cells in column B are empty before procedure runs

Another option (which is less elegant than solution posted by @jmacleary)
VBA Code:
Sub GetInput()
    Dim cel As Range, cel2 As Range, lastCel As Range, v As Variant
    Application.ScreenUpdating = False
    Set lastCel = Range("A" & Rows.Count).End(xlUp)
    For Each cel In Range("A2", lastCel)
        If cel.Offset(, 1) = "" Then
            v = InputBox("Enter value for " & cel.Value, "User Input")
            For Each cel2 In Range(cel, lastCel)
                If cel2 = cel Then cel2.Offset(, 1) = v
            Next cel2
        End If
    Next cel
End Sub
Hi Jongle,

that works fine but not exactly as i need it, i think my description was not really clear.

In fact in this example i have 3 different values A, B and C in column 1. For each value i have to give an input. As A and B are 3 times in column 1 i want to avoid to introduce a value for each A (as it will be always the same value to put in column 2. the same case for C.
So for example for A, i input 1 and that value is copied to the cells B2, B3 and B4. I hope you understand it now better. For B i input 2 and that value is copied to the cells B5, B6 and B7. I hope you understand it now better. thanks for ur help
 
Upvote 0
I assume that all cells in column B are empty before procedure runs

Another option (which is less elegant than solution posted by @jmacleary)
VBA Code:
Sub GetInput()
    Dim cel As Range, cel2 As Range, lastCel As Range, v As Variant
    Application.ScreenUpdating = False
    Set lastCel = Range("A" & Rows.Count).End(xlUp)
    For Each cel In Range("A2", lastCel)
        If cel.Offset(, 1) = "" Then
            v = InputBox("Enter value for " & cel.Value, "User Input")
            For Each cel2 In Range(cel, lastCel)
                If cel2 = cel Then cel2.Offset(, 1) = v
            Next cel2
        End If
    Next cel
End Sub
Hi Paul. Try this code:
VBA Code:
Sub Paul82()
    Dim Answer As String
    Dim OneRow As Long
    Dim OneValue As String
    Dim LastRow As Long
    Dim AllRows As New Scripting.Dictionary
    LastRow = Range("A65536").End(xlUp).Row

    For OneRow = 2 To LastRow
        OneValue = Cells(OneRow, 1).Value
        If AllRows.exists(OneValue) Then
            Cells(OneRow, 2).Value = AllRows(OneValue)
        Else
            Answer = InputBox("Please enter a value for " & OneValue)
            Cells(OneRow, 2).Value = Answer
            AllRows(OneValue) = Answer
        End If
    Next

End Sub

Hi jmacleary, thank for your reply. But this is not working for me :( "Dim AllRows As New Scripting.Dictionary" is unable by the administrator. So i cannot run this code. Kind regards
 
Upvote 0
Hi Paul. Sorry I forgot to say. To use my solution you will need to have the VBScripting reference turned on. In the VB editor, select Tools, References, and scroll down to find 'Microsoft Scripting Runtime'. Check the box by it and try again. But if your organisation has restrictions beyond that, then I can't help I don't think.
 
Upvote 0
Hi Jongle,

that works fine but not exactly as i need it, i think my description was not really clear.

In fact in this example i have 3 different values A, B and C in column 1. For each value i have to give an input. As A and B are 3 times in column 1 i want to avoid to introduce a value for each A (as it will be always the same value to put in column 2. the same case for C.
So for example for A, i input 1 and that value is copied to the cells B2, B3 and B4. I hope you understand it now better. For B i input 2 and that value is copied to the cells B5, B6 and B7. I hope you understand it now better. thanks for ur help

I am puzzled by your comments
With values as in sheet below the code asks
for A once
for B once
for C once

Book1
AB
1
2A
3A
4A
5B
6B
7C
Sheet2
 
Upvote 0
I agree. I think Yongle's solution works as requested.
 
Upvote 0
I am puzzled by your comments
With values as in sheet below the code asks
for A once
for B once
for C once

Book1
AB
1
2A
3A
4A
5B
6B
7C
Sheet2
yes exactly instead of requesting 3 times a value for A and B. it just just as one time, as the value is the same for all A in column A. idem for B
 
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,101
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top