How to get data using header name ranges in Excel in case columns are dynamic?

I have here a simple form that matches data when ID is entered. It works fine. However, these columns are dynamic/interchangeable. What I would like to do is set the foundcell variable range from column numbers to header names so whenever the columns are interchanged, ID still has matching intact data after update.

Image of Sheet1 Data

Text Data

ID  Description 1   Description 2   Description 3   Description 4
1       Abc             123             Red             Yes
2       Def             456             Blue            Yes
3       Ghi             789             Orange          Yes
4       Jkl             0               Yellow          No

So below is a sample matching data for ID 2.

VBA Excel Code

Private Sub id_Change()
Dim id As Variant, rowcount As Integer, foundcell As Range
id = Me.id.value
    rowcount = ThisWorkbook.Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).row
        With ThisWorkbook.Sheets("Sheet1").Range("A1:A" & rowcount)
        Set foundcell = .Find(what:=id, LookIn:=xlValues)
          If Not foundcell Is Nothing Then                
                desc1.value = .Cells(foundcell.row, 2) 'I would like to name this as Description 1
                desc2.value = .Cells(foundcell.row, 3) 'I would like to name this as Description 2
                desc3.value = .Cells(foundcell.row, 4) 'I would like to name this as Description 3
                desc4.value = .Cells(foundcell.row, 5) 'I would like to name this as Description 4
            Else
                 desc1.value = ""
                 desc2.value = ""
                 desc3.value = ""
                 desc4.value = ""
            End If
        End With
End Sub

Please advise. Thank you..

Solution

EDIT: switched back to Find() for matching the row....

You could do something like this, using a Dictionary:

Private Sub id_Change()
    Dim id As Variant, headers As Object, ws As Worksheet, f As range
    id = Me.id.Value
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set headers = AllHeaders(ws, 1) 'get column headers from first row
    Set f = ws.Columns(headers("ID")).Find(id, Lookat:=xlWhole, _
                                             Lookin:=xlValues)
    If Not f Is Nothing Then
        With f.EntireRow
            desc1.Value = .Cells(headers("Description 1"))
            desc2.Value = .Cells(headers("Description 2"))
            desc3.Value = .Cells(headers("Description 3"))
            desc4.Value = .Cells(headers("Description 4"))
        End With
    Else
        desc1.Value = ""
        desc2.Value = ""
        desc3.Value = ""
        desc4.Value = ""
    End If
End Sub

'Return a Dictionary mapping all headers on row `rw` of sheet `ws`
'   to their column positions.  Assumes all headers are unique.
Function AllHeaders(ws As Worksheet, rw As Long) As Object
    Dim dict As Object, v As String, c As Range
    Set dict = CreateObject("scripting.dictionary")
    dict.comparemode = 1 'vbTextCompare: case-insensitive
    For Each c In ws.Range(ws.Cells(rw, 1), ws.Cells(rw, Columns.Count).End(xlToLeft)).Cells
        v = c.Value
        If Len(v) > 0 Then dict.Add v, c.Column 'map headers to column number
    Next c
    Set AllHeaders = dict
End Function