I am looking for code to perform the following.

On one tab called Close P.O. Form, users will enter the PO# that is to be closed and press Close PO Button

On the data base tab, a list of PO's are listed in Col A.

I need a macro that will take the PO Number entered in the "Close PO Tab" and search for the PO number in the "Data Base Tab". Once found in the data base, I want misc information copied from cell D4 in the Close PO Tab and pasted in the Data Base tab offset 12 columns to the right of Col A.

The code i found only works when i am on the data base tab. So does not work when i hit the Close PO button on the Close PO Tab.

Code:

Sub Close_PO()
Dim Fnd As Range
Dim Data_Base As Worksheet
Set Data_Base = Worksheets("Data Base")
Dim Close_PO_Form As Worksheet
Set Close_PO_Form = Worksheets("Close P.O. Form")
Dim Close_PO_Number As Range
Set Close_PO_Number = Close_PO_Form.Range("B4")
Dim Data_Base_PO_Col As Range
Set Data_Base_PO_Col = Data_Base.Range("A:A")
Close_PO_Form.Range("D4").Copy
With Data_Base
Set Fnd = Data_Base_PO_Col.Find(WHAT:=Close_PO_Number, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext, MatchCase:=False)
        Fnd.Activate
        
        ActiveCell.Select
        ActiveCell.Offset(0, 12).Select
        ActiveCell.Select
        Selection.PasteSpecial (xlPasteValues)
        Debug.Print Fnd.Address
End With
End Sub

I am looking for code to perform the following.

On one tab called Close P.O. Form, users will enter the PO# that is to be closed and press Close PO Button

On the data base tab, a list of PO's are listed in Col A.

I need a macro that will take the PO Number entered in the "Close PO Tab" and search for the PO number in the "Data Base Tab". Once found in the data base, I want misc information copied from cell D4 in the Close PO Tab and pasted in the Data Base tab offset 12 columns to the right of Col A.

The code i found only works when i am on the data base tab. So does not work when i hit the Close PO button on the Close PO Tab.

Code:

Sub Close_PO()
Dim Fnd As Range
Dim Data_Base As Worksheet
Set Data_Base = Worksheets("Data Base")
Dim Close_PO_Form As Worksheet
Set Close_PO_Form = Worksheets("Close P.O. Form")
Dim Close_PO_Number As Range
Set Close_PO_Number = Close_PO_Form.Range("B4")
Dim Data_Base_PO_Col As Range
Set Data_Base_PO_Col = Data_Base.Range("A:A")
Close_PO_Form.Range("D4").Copy
With Data_Base
Set Fnd = Data_Base_PO_Col.Find(WHAT:=Close_PO_Number, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext, MatchCase:=False)
        Fnd.Activate
        
        ActiveCell.Select
        ActiveCell.Offset(0, 12).Select
        ActiveCell.Select
        Selection.PasteSpecial (xlPasteValues)
        Debug.Print Fnd.Address
End With
End Sub

• excel
• vba
• find

2 Answers 2

Option Explicit

Sub Close_PO()

    Dim wsData As Worksheet, wsForm As Worksheet
    Dim rngFind As Range, POnum As String
    
    With ThisWorkbook
       Set wsData = .Sheets("Data Base")
       Set wsForm = .Sheets("Close P.O. Form")
    End With
    
    With wsForm
        POnum = .Range("B4").Value
        Set rngFind = wsData.Range("A:A").Find(POnum, _
               LookIn:=xlValues, lookat:=xlWhole, _
               searchdirection:=xlNext, MatchCase:=False)
               
        If rngFind Is Nothing Then
            MsgBox POnum & " not found on " & wsData.Name, vbExclamation
        Else
            Debug.Print POnum, rngFind.Address
            rngFind.Offset(, 12) = .Range("D4").Value
        End If
    End With
    
End Sub

A VBA Lookup

Sub Close_PO()
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Store the source lookup and return values in variables.
    Dim sws As Worksheet: Set sws = wb.Sheets("Close P.O. Form")
    Dim sLookup As Variant: sLookup = sws.Range("B4").Value
    Dim sReturn As Variant: sReturn = sws.Range("D4").Value
    
    ' Reference the destination lookup range.
    Dim dws As Worksheet: Set dws = wb.Sheets("Data Base")
    Dim dlrg As Range, dRowsCount As Long
    With dws.Range("A2") ' top cell?
        dRowsCount = dws.Cells(dws.Rows.Count, .Column) _
            .End(xlUp).Row - .Row + 1
        If dRowsCount < 1 Then Exit Sub ' no data
        Set dlrg = .Resize(dRowsCount)
    End With
    
    ' Reference the destination lookup (found) and return cells.
    Dim dlcell As Range: Set dlcell = dlrg.Find(What:=sLookup, _
        After:=dlrg.Cells(dlrg.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole)
    If dlcell Is Nothing Then Exit Sub ' lookup value not found
    Dim drcell As Range: Set drcell = dlcell.EntireRow.Columns("M")
    
    ' Copy values.
    drcell.Value = sReturn

End Sub