Search code examples
excelvbabuttonrangecriteria

Excel VBA assistance please; copy a value from Sheet1 to a criteria matching cell in Sheet2

I'm trying to make a inventory tracking Excel where I can scan a UPC in, enter the quantity and click a button to enter it into my inventory.

Sheet1 is where I enter the UPC, the box ID and the quantity for that UPC. Sheet2 will already be prefilled with column titles as all the available the box IDs, and the rows labeled as all available UPC. All I need to do now is copy the quantity value from Sheet1 to the box ID and UPC matching cell.

Here is a screenshot example of what I mean:

screenshot

Note that COLUMN_ID will be BOX_ID and ROW_ID will be the UPC in the real spreadsheet. You can download the example spreadsheet here.

The only problem I face is the VBA involved with copying the UPC from Sheet1 to Sheet2. Any ideas?

EDIT [SOLVED]:

Sub copyFindPaste()
    ' hiker95, 10/22/2014, ME813408
    Dim wSheet1 As Worksheet, wSheet2 As Worksheet
    Dim foundRow As Range, foundCol As Range
    Application.ScreenUpdating = False
    Set wSheet1 = Sheets("Sheet1")
    Set wSheet2 = Sheets("Sheet2")
    With wSheet1
      Set foundRow = wSheet2.Columns(1).Find(.Range("B2").Value, LookAt:=xlWhole)
      Set foundCol = wSheet2.Rows(1).Find(Range("A2").Value, LookAt:=xlWhole)
      If (Not foundRow Is Nothing) * (Not foundCol Is Nothing) Then
        With wSheet2.Cells(foundRow.Row, foundCol.Column)
          .Value = Range("C2").Value
          .HorizontalAlignment = xlCenter
        End With
        Set foundRow = Nothing: Set foundCol = Nothing
      End If
    End With
    Application.ScreenUpdating = True
End Sub
Solution

  • Untested

    Sub copyAndFind()
    Dim copyFrom As Worksheet, copyTo As Worksheet
    Dim copyValue As Integer
    Dim matchColId As Text
    Dim matchRowId As Text
    Dim fC As Range, fR as range

    Set copyFrom = ThisWorkbook.Sheets("Sheet1")
    Set copyTo = ThisWorkbook.Sheets("Sheet2")
    Set matchColId = Cell("A2").Value
    Set matchRowId  = Cell("B2").Value
    Set copyValue  = Cell("C2").Value

    Set fC = copyTo.Rows(1).find(What:=matchColId, lookAt:=xlWhole)
    Set fR = copyTo.Columns(1).find(What:=matchRowId, lookAt:=xlWhole) 

    If Not fC is nothing and not fR is nothing then
        copyTo.cells(fC.Column, fR.Row).Value = copyValue
    else
        Msgbox "Couldn't match Row and/or Column header!"
    end if

End Sub