VBA - Insert data in different cells without interruption-CodePudding

I have a worksheet, in this I would like to fill different cells by an input.

Currently it works by clicking in the cell. However, you have to click on each cell individually.

Now I want that when I confirm the input in the first cell, the input for the second value appears directly and so I can fill up to 5 values in a row without clicking each time.

So i click a button it should open a input dialog, there i insert my input, then it appears in the first cell, without closing it changes to second input dailog, where i insert my input again ....

Here my code of the currect solution.

I hope u understand and can help me with this function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim varEintrag
    If Target.Cells(1).Address(0, 0) = "D12" Then
        varEintrag = Application.InputBox("Bitte Wert eintragen", "Dateneingabe")
        If varEintrag <> "Falsch" And varEintrag <> "False" Then
            If IsNumeric(varEintrag) Then
                Target = CDbl(varEintrag)
            Else
                Target = varEintrag
            End If
        End If
    End If
End Sub```

CodePudding user response：

Trigger Multiple Cells Entry

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ClearError
    
    Const iAddress As String = "D12"
    Const mrgAddress As String = "D12,E12,D13,D15,E15"
    
    Dim iCell As Range
    
    Set iCell = Intersect(Range(iAddress), Target)
    If iCell Is Nothing Then Exit Sub
    
    Dim mrg As Range: Set mrg = Range(mrgAddress)
    
    Application.EnableEvents = False
    
    Dim varEintrag As Variant
    
    For Each iCell In mrg.Cells
        
        varEintrag = Application.InputBox( _
            Prompt:="Bitte Wert in Zelle '" & iCell.Address(0, 0) _
                & "' eintragen:", _
            Title:="Dateneingabe", _
            Default:=iCell.Value)
    
        If varEintrag <> "Falsch" And varEintrag <> "False" Then
            If IsNumeric(varEintrag) Then
                iCell.Value = CDbl(varEintrag)
            Else
                iCell.Value = varEintrag
            End If
        Else
            Exit For ' Cancel
        End If
    
    Next iCell

SafeExit:
    If Not Application.EnableEvents Then Application.EnableEvents = True

    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub

CodePudding user response：

Please, try this modified event. It consecutively asks about the 5 necessary inputs and then place them in the necessary range:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim varEintrag, arrE(4), i As Long, k As Long
    If Target.Rows.count > 1 Or Target.Columns.count > 1 Then Exit Sub
    
    If Target.cells(1).Address(0, 0) = "D12" Then
        Dim rngRet As Range: Set rngRet = Range("D12, E12, D13, D15, E15")
        For i = 0 To UBound(arrE)
            varEintrag = Application.InputBox("Bitte Wert eintragen " & i   1, "Dateneingabe")
            If varEintrag <> "Falsch" And varEintrag <> "False" Then
                If IsNumeric(varEintrag) Then
                    arrE(k) = CDbl(varEintrag): k = k   1
                Else
                    arrE(i) = varEintrag: k = k   1
                End If
            End If
        Next i

        Dim cel As Range: k = 0
        For Each cel In rngRet.cells
            cel.Value = arrE(k): k = k   1
        Next
    End If
End Sub

Edited:

This is a version iterating between each discontinuous range cells and ask for input in each such a cell address:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Rows.count > 1 Or Target.Columns.count > 1 Then Exit Sub
    
    If Target.cells(1).Address(0, 0) = "D12" Then
        Dim rngRet As Range: Set rngRet = Range("D12, E12, D13, D15, E15")
        Dim varEintrag, cel As Range
        For Each cel In rngRet.cells
            varEintrag = Application.InputBox("Bitte Wert eintragen in " & cel.Address, "Dateneingabe")
            If varEintrag <> "Falsch" And varEintrag <> "False" Then
                If IsNumeric(varEintrag) Then
                    cel.Value = CDbl(varEintrag)
                Else
                    cel.Value = varEintrag
                End If
            End If
        Next cel
    End If
End Sub