How could I speed up this macro?

I'm relatively new to VBA, and this macro can take minutes to wrong on only a few entries and I'm just curious as to what I'm doing wrong and how to improve the runtime speeds.

I tried inputting some lines that were supposedly able to speed up my code, however, after testing there's no difference in runtime whatsoever.

Sub CompareMacro()

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
    
Dim currentRow As Long
Dim currentSearch As String
Dim compareCount, arrCount As Long
Dim columnCount, compareColumnCount As Variant
Dim partListCount As Variant

partListCount = Worksheets("PART LIST").UsedRange.Value
columnCount = Worksheets("PART LIST").UsedRange.Columns.Count
compareColumnCount = Worksheets("COMPARE").UsedRange.Columns.Count
compareCount = 0
arrCount = 0
currentRow = 2

For x = 1 To columnCount
    If InStr(Worksheets("PART LIST").Cells(1, x).Value, "modelno") Then
        compareCount = compareCount + 1
    End If
Next x

ReDim arr(1 To compareCount) As Variant
ReDim arr2(1 To compareCount) As Variant

For y = 1 To columnCount
    If InStr(Worksheets("PART LIST").Cells(1, y).Value, "modelno") Then
        arrCount = arrCount + 1
        arr(arrCount) = y
        arr2(arrCount) = Worksheets("PART LIST").Cells(1, y).Value
    End If
Next y

While (Not (IsEmpty(Worksheets("COMPARE").Cells(currentRow, 1))))
    For b = 1 To compareCount
        For c = 1 To UBound(partListCount)
            If (partListCount(c, arr(b)) = Worksheets("COMPARE").Cells(currentRow, 1).Value) Then
                For d = 1 To compareColumnCount
                    If (Worksheets("COMPARE").Cells(1, d) = arr2(b)) Then
                        Worksheets("COMPARE").Cells(currentRow, d) = partListCount(c, 1)
                    End If
                Next d
            End If
        Next c
    Next b
    currentRow = currentRow + 1
Wend
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView
End Sub

I can't see the structure of your workbook, however, if we assume that your original code does what it is supposed to do but slowly, then it can be made faster by reading and writing all cells in one call (as much as possible).

There is a limitation to this, however. If there are formulas on the COMPARE worksheet, then you can't overwrite all cells at once because the cell would not contain, e.g. =1+2 anymore but would be overwritten with 3.

So Option A is to overwrite everything at once, Option B is to overwrite only cells that you want to modify, one by one. My (untested) macro is the following:

Public Sub CompareMacro()
    Dim partlist() As Variant: partlist = ThisWorkbook.Worksheets("PART LIST").UsedRange.Value
    
    Dim mCount As Long: mCount = 0
    Dim mCols() As Long
    Dim mVals() As Variant
    Dim pCol As Long: For pCol = LBound(partlist, 2) To UBound(partlist, 2)
        If InStr(1, partlist(1, pCol), "modelno") <> 0 Then
            mCount = mCount + 1
            ReDim Preserve mCols(1 To mCount)
            mCols(mCount) = pCol
            ReDim Preserve mVals(1 To mCount)
            mVals(mCount) = partlist(1, pCol)
        End If
    Next
    
    Dim compare() As Variant: compare = ThisWorkbook.Worksheets("COMPARE").UsedRange.Value
    
    Dim cRow As Long: For cRow = LBound(compare, 1) + 1 To UBound(compare, 1)
        Dim m As Long: For m = 1 To mCount: Dim mCol As Long: mCol = mCols(m): Dim mVal As Variant: mVal = mVals(m)
            Dim pRow As Long: For pRow = LBound(partlist, 1) To UBound(partlist, 1)
                If partlist(pRow, mCol) = compare(cRow, 1) Then
                    Dim cCol As Long: For cCol = LBound(compare, 2) To UBound(compare, 2)
                        If compare(1, cCol) = mVal Then
                            
                            ' Option A
                            compare(cRow, cCol) = partlist(pRow, 1)
                            
                            ' Option B
                            ' ThisWorkbook.Worksheets("COMPARE").Cells(cRow, cCol) = partlist(pRow, 1)
                            
                        End If
                    Next
                End If
            Next
        Next
    Next
    
    ' Option A
    ThisWorkbook.Worksheets("COMPARE").UsedRange.Value = compare

End Sub

The Application.ScreenUpdating ... Application.StatusBar stuff does not make any improvement in this case, just makes the code less readable, and annoys the user if the macro fails. So, get rid of it.

If you want to further improve the performance, you should reconsider your worksheets' structure, and normalize your database.