Number Lookup and paste as Values in Another Sheet

[fareedexcel]

Hi Excelers,

I have an input and output sheet. Input sheet has 2 Data validation list and a Enter Quantity field where a RANDOM NUMBER can be entered. Once click the Enter button, this RANDOM NUMBER to be copied to the OUTPUT sheet with correspond to the 2 data validation selections.

Every time I choose a different validation criteria in the Input Sheet and provide a RANDOM NUMBER which should be captured in the OUTPUT SHEET once I click Enter Button.

Also I need an option to replace an existing value in the OUTPUT sheet in case if required.

Please support.

 

[rahulshewale1]

hi @fareedexcel ,

See if is it ok ?

Option Explicit

Sub Copy_Data()

Dim ic As Variant
Dim bn As Integer
Dim qty As Integer

Dim actws As Worksheet
Dim outws As Worksheet

Set actws = ThisWorkbook.Worksheets("Input Sheet")
Set outws = ThisWorkbook.Worksheets("Output Sheet")

Dim lr As Integer
Dim lc As Integer

Dim i As Long
Dim c As Long
lr = Application.WorksheetFunction.CountA(outws.Range("A1:A" & Range("A1").End(xlDown).Row)) - 1
lc = Application.WorksheetFunction.Max(outws.Range("1:1")) + 1

Dim lookupitemcode As String
Dim lookupBoxNo As Integer

Dim rowi As Integer
rowi = 1

For i = 2 To lr

    For c = 2 To lc
            lookupitemcode = outws.Cells(i, 1).Value
            lookupBoxNo = outws.Cells(1, c)
        
        If lookupitemcode = actws.Range("Items_Code") And lookupBoxNo = actws.Range("Box_No") Then
            outws.Cells(i, c).Value = actws.Range("Enter_Qty")
        End If
    Next c

Next i
End Sub

 

[fareedexcel]

Hi Rahul,

Thanks for the code. It is working perfectly. How to get a confirmation message box?

Once I click Enter, I should get a confirmation message - "Quantity is added to the Output Sheet"

--------------------

Also, if there is any change in the number, like replacing the existing cell value in the output sheet,

For replacing the value, confirmation message should be - "Do you want to replace the existing Quantity in the Output Sheet"

Please help in adding this 2 messages.

 

[rahulshewale1]

Hi Rahul,

Thanks for the code. It is working perfectly. How to get a confirmation message box?

Once I click Enter, I should get a confirmation message - "Quantity is added to the Output Sheet"

--------------------

Also, if there is any change in the number, like replacing the existing cell value in the output sheet,

For replacing the value, confirmation message should be - "Do you want to replace the existing Quantity in the Output Sheet"

Please help in adding this 2 messages.

hi @fareedexcel ,

See if is it ok ?

Option Explicit

Sub Copy_Data()

Dim actws As Worksheet
Dim outws As Worksheet

Set actws = ThisWorkbook.Worksheets("Input Sheet")
Set outws = ThisWorkbook.Worksheets("Output Sheet")

Dim lr As Integer
Dim lc As Integer

lr = Application.WorksheetFunction.CountA(outws.Range("A1:A" & Range("A1").End(xlDown).Row)) - 1
lc = Application.WorksheetFunction.Max(outws.Range("1:1")) + 1

Dim i As Long
Dim c As Long

Dim lookupitemcode As String
Dim lookupBoxNo As Integer

Dim rowi As Integer
rowi = 1

Dim msgResult As Integer

For i = 2 To lr

    For c = 2 To lc
            lookupitemcode = outws.Cells(i, 1).Value
            lookupBoxNo = outws.Cells(1, c)
            
        If lookupitemcode = actws.Range("Items_Code") And lookupBoxNo = actws.Range("Box_No") And outws.Cells(i, c).Value <> "" Then
            
            msgResult = MsgBox("Do you Replace The existing Quantity in Output Sheet", vbYesNo)
        
                If msgResult = 6 Then
                    If lookupitemcode = actws.Range("Items_Code") And lookupBoxNo = actws.Range("Box_No") Then
                        outws.Cells(i, c).Value = actws.Range("Enter_Qty")
                    End If
                    Exit Sub
                End If
                Exit Sub
         Else
        
            If lookupitemcode = actws.Range("Items_Code") And lookupBoxNo = actws.Range("Box_No") Then
                    outws.Cells(i, c).Value = actws.Range("Enter_Qty")
                    MsgBox "Quantity is added to the Output Sheet"
            
            End If
            
            End If
          
        
Next c
Next i
End Sub

 

[fareedexcel]

Hi Rahul,

This really helps. Your support is much appreciated.

 

[fareedexcel]

Hi Rahul @rahulshewale1

Please note i tried the same code in my sheet. But my original sheet has almost 8000 rows and 500 columns.

When I press the enter key, VBA is not responding. Is there any ways to sort this problem out?

 

[fareedexcel]

Can you please support on the above attachment as VBA takes too much time to processing the request.

 

[rahulshewale1]

Can you please support on the above attachment as VBA takes too much time to processing the request.

Try This much Faster

Option Explicit


Sub test()

Dim RowNo As Variant
Dim ColumnNumber As Integer

Dim actws As Worksheet
Dim outws As Worksheet

Set actws = ThisWorkbook.Worksheets("Input Sheet")
Set outws = ThisWorkbook.Worksheets("Output Sheet")


Dim msgResult As Integer

Dim lr As Integer

lr = Application.WorksheetFunction.CountA(outws.Range("A1:A" & Range("A1").End(xlDown).Row)) + 1

    RowNo = Application.WorksheetFunction.Match(actws.Range("Items_Code"), outws.Range("A1:A" & lr), 0)
    ColumnNumber = Application.WorksheetFunction.Match(actws.Range("Box_No"), outws.Range("1:1"), 0)

If outws.Cells(RowNo, ColumnNumber).Value <> "" Then
        msgResult = MsgBox("Do you Replace The existing Quantity in Output Sheet", vbYesNo)
    If msgResult = 6 Then
        outws.Cells(RowNo, ColumnNumber).Value = actws.Range("Enter_Qty")
   
    End If
    Exit Sub
Else

    outws.Cells(RowNo, ColumnNumber).Value = actws.Range("Enter_Qty")
    MsgBox "Quantity is added to the Output Sheet"
 

End If

End Sub

 

[fareedexcel]

Hi @rahulshewale1 ,

Thanks this code really does magic. What you have done? instead of going through all the rows and columns. It will go to the specific cells to paste the values? You smart dude.