简体   繁体   中英

Excel VBA Macros: Find/Match cells from one sheet to a column in another

Ok, so I have a workbook with multiple sheets. The Worksheets are named:

Inputs Outputs Hardware

Input and output are serial IDs matched to actualy IP Addresses.
Input 1 : 192.168.0.1 input 2 : 192.168.0.2 ... etc

Hardware has 3 columns. The first has Devices, 2nd column which has the Input Serial IDs and the 3rd of Output Serial IDs.

Toaster : Input 1 : Output 3 Blender : Input 2 : Output 2 ...etc

Now, normally, I'd be using Vlookup(A1,Inputs!A:B,2) and Vlookup(A1,Outputs!A:B,2), but I have to incorporate this into the VBA macro we have and I have no idea how.

Sub TrackHardware()

'~~~~~~~~~~~~~~~~~~~~~
'Activating Device
'~~~~~~~~~~~~~~~~~~~~~
currentOutputRow = 2
Dim test As String


For currentRow = 2 To 32768 'The last row of your data
'For Loop to go through contents of Hardware individually

    If Not (IsEmpty(Worksheets("Hardware").Range("A" & currentRow).Value)) Then
        'To Skip the empty cells 

            HWID=Worksheets("Hardware").Range("a" & currentvalue).Value
            'HWID is the search term coming from Sheet:'Hardware'

            Desc=Worksheets("Hardware").Range("D" & currentvalue).Value
            'Desc is the Plain Text description coming from Sheet:'Hardware'



            inputrow={Match pseudocode that didn't work(HWID, "Inputs", Range:= "A:B", 2) }
            outputrow={Match pseudocode that didn't work(HWID, "Outputs", Range:= "A:B", 2) }
            'trying to find the row # of search term in Sheets 'Input' and 'Output'

            Worksheets("Inputs").Range("C" & inputrow).Value = Desc
            Worksheets("Outputs").Range("C" & outputrow).Value = Desc
             'Pastes The Device Description to Input and Output Sheets



    End If
Next currentRow
'And on to the next line in 'Hardware'

End Sub

I'd also like to account for Errors like 2 devices on the same Input/Output or a Blank cell, but I think I can figure those out myself. This Find function is what's really giving me a lot of trouble.

First, there seems to be a problem if you are not able to call on the Application.Match function. I am not sure why that would be missing, but I know there are some "limited" versions of Office/Excel which do not have full VBA functionality. I am not sure if that is the case with your installation.

Now, on to your problem though...

To use the Application.Match function:

The Match function takes a single row or single column range input. You are attempting to pass in the range "A:B" , which will always raise an error. Change to a single row/column range instead.

Further, 2 is not an option for the third argument, which can be either -1 (less than), 0 or False (exact), or 1 (greater than). I'm not sure this alone will raise an error, but you should fix it anyways.

inputRow = Application.Match(HWID, Worksheets("Inputs").Range("A:A"), False)

If an exact match cannot be found, it will raise an error, which you can trap like so:

inputRow = Application.Match(HWID, Worksheets("Inputs").Range("A:A"), False)
If IsError(inputRow) Then
    'Do something like:
    MsgBox HWID & " not found!", vbInformation
    Exit Sub
End If

NOTE If you actually need to check both columns, then you can either double up on the Match function, or use the range .Find method instead.

Dim foundRange as Range
Set foundRange = Range("A:B").Find(HWID)
If Not foundRange Is Nothing Then
    inputRow = foundRange.Row
Else
    MsgBox HWID & " not found!", vbInformation
End If

Handling errors with WorksheetFunction.Match

Error trapping for Application.WorksheetFunction.Match should be something like:

inputRow = Empty
On Error Resume Next
inputRow = Application.WorksheetFunction.Match(HWID, Worksheets("Inputs").Range("A:A"), False)
If Err.Number <> 0 Then
    MsgBox "Match not found", vbInformation
    Exit Sub
End If
On Error GoTo 0

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM