InputBox Entry to worksheet range cell

[SherriM]

I have a workbook with two spreadsheets. Sheet1 includes two columns as below. Column F is a drop down list based on named range on sheet 3 and Column G is xlookup formula as below.

=XLOOKUP([@CUSTOMER],CustomerTable1[Customer], CustRange,"")


When a customer already on the drop down list is chosen, the CustNum column populates with appropriate CustNum from the table below. However, when a new customer is added on sheet1, there is VBA code to add the new customer name to the bottom of the Customer column on sheet 3. Then an inputbox allows the new customer number to be entered as coded below.

Based on code below, the new customer number should be showing up in the last row of sheet 3, column E so the xlookup formula can have it enter on sheet1, Column G, but it does not.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim CustNumb As Variant
Dim rngNum As Range

CustNumb = Application.InputBox(Prompt:="Enter a Number ONLY", Title:="Enter Number for New Customer", Type:=1)

If CustNumb <> "" Then
rngNum("CustRange").End(xlUp).Offset(1, 0).Select
rngNum.Value = CustNumb

End If
End Sub


Any help is much appreciated.

 

[BigBeachBananas]

Try this.

WARNING: UNABLE TO UNDO CHANGES. TRY ON A COPY OF YOUR WORKBOOK.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CustNumb As Variant
    Dim rngNum As Range
    Dim LastRow As Long

    Set rngNum = Intersect(Target, Me.Range("A:A"))'<~~ Change column as needed

    If Not rngNum Is Nothing And rngNum.Count = 1 And rngNum.Value <> "" Then
        CustNumb = Application.InputBox("Enter a Number ONLY", "Enter Number for New Customer", 1)

        If CustNumb <> "" Then
            LastRow = ThisWorkbook.Sheets("Sheet3").Cells(Rows.Count, "E").End(xlUp).Row + 1
            ThisWorkbook.Sheets("Sheet3").Cells(LastRow, "E").Value = CustNumb
        End If
    End If
End Sub

 

[SherriM]

Thanks. Your solution looks promising. But when I tried to run it, I got the following message and debug highlighted the row with the problem in yellow. I also tried the Me.Range as E:E with the same result.

 

[BigBeachBananas]

hm... Try this maybe?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CustNumb As Variant
    Dim rngNum As Range
    Dim LastRow As Long

    Set rngNum = Intersect(Target, Me.Range("A:A")) '<~~ Change column as needed

    If Not rngNum Is Nothing And rngNum.Count = 1 And rngNum.Value <> "" Then 'Error here
        CustNumb = Application.InputBox("Enter a Number ONLY", "Enter Number for New Customer", 1)

        If CustNumb <> "" Then
            ' Qualify Rows with a specific worksheet
            LastRow = ThisWorkbook.Sheets("Sheet3").Cells(ThisWorkbook.Sheets("Sheet3").Rows.Count, "E").End(xlUp).Row + 1
            ThisWorkbook.Sheets("Sheet3").Cells(LastRow, "E").Value = CustNumb
        End If
    End If
End Sub

 

[SherriM]

Hmm....

The code produced an endless loop. It kept asking for the customer number, but didn't put it in the right place and then started entering false. I had to close all windows to get out.

 

[Akuini]

@SherriM
Could you please upload a sample workbook (without sensitive data) to a file-sharing site like Dropbox.com or Google Drive, and then share the link here? Also, ensure that the link is accessible to anyone.

 

[dmt32]

Hi
if object variable rngNum is Nothing then the other tests in that line will error

If Not rngNum Is Nothing And rngNum.Count = 1 And rngNum.Value <> "" Then 'Error here

try this update to your code & see if resolves the error

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CustNumb    As Variant
    Dim rngNum      As Range
    Dim LastRow     As Long
    
    Set rngNum = Intersect(Target, Me.Range("A:A"))        '<~~ Change column as needed
  
    If Not rngNum Is Nothing Then
        If rngNum.Count = 1 And rngNum.Value <> "" Then
            CustNumb = Application.InputBox("Enter a Number ONLY", "Enter Number For New Customer", 1)
            
            If CustNumb <> "" Then
                LastRow = ThisWorkbook.Sheets("Sheet3").Cells(Rows.Count, "E").End(xlUp).Row + 1
                ThisWorkbook.Sheets("Sheet3").Cells(LastRow, "E").Value = CustNumb
            End If
        End If
    End If
  
End Sub

Dave