excelvbamatch

VBA: Using two existing values to create an intersection


I have two separate tables, one containing the location information and current quarter in a fixed position.

LocationB Quarter1

I would like to run a macro, which takes the above mentioned information and marks the intersecting cell with a value in a different worksheet.

Location Quarter1 Quarter2 Quarter3 Quarter4
LocationA -------- -------- -------- --------
LocationB Green -------- -------- --------
Locationc -------- -------- -------- --------

My idea is to use match to determine the correct row and column number and then just insert a value there. However, I struggle to use match correctly.

The lookup value is on the current worksheet, while the accompanying array to find the row number is on the adjacent worksheet.

Sub Test()

Dim wsUB As Worksheet
Dim UBLocation As Variant

Set wsUB = ThisWorkbook.Worksheets("Übersichtsblatt")

UBLocation = Application.Match(Cells(6, 3), wsUB.Range("A1:A35"), 0)


End Sub

I get the error code 2042

Many thanks for any suggestions or advice.


Solution

  • I would recommend using ADO/SQL for this problem, especially if you have much records to be updated from the other sheet.

    Sub Test()
        Dim adoCN As Object, TargetFile As String, strSQL As String
        Dim UBLoc As String, UBQuarter As String
        
        UBLoc = Sheets("Arbeitsblatt").Range("C6")
        UBQuarter = Sheets("Arbeitsblatt").Range("E6")
       
        Set adoCN = CreateObject("ADODB.Connection")
        
        TargetFile = ThisWorkbook.FullName
        
        adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
        adoCN.Properties("Data Source") = TargetFile
        adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
        adoCN.Open
            
        strSQL = " Update [Übersichtsblatt$] As T1 " & _
                 " Set T1.[Quarter1] = '" & UBQuarter & "'" & _
                 " Where T1.[Location]= '" & UBLoc & "'"
       
        adoCN.Execute (strSQL)
        
        adoCN.Close
        Set adoCN = Nothing
    End Sub