loop در دو کمبوباکس

[intro]

باسلام و احترام
یه فرمی درست کردم که در اون دوتا کمبو باکس را به هم ارتباط دادم در کمبوی اولی کد زیر را نوشتم

Private Sub ComboBox1_Change()
Dim c As Range
On Error Resume Next
For Each c In Sheet12.Range("c2:c5000")
    If c = ComboBox1.Text Then
        ComboBox24.Text = c.Offset(0, -1)
    End If
Next
If ComboBox24.Text = "" Then
    ComboBox1.Text = ""
End If
End Sub

و در کمبوی دومی کد زیر

Dim c As Range
On Error Resume Next
For Each c In Sheet12.Range("b2:b5000")
    If c.Value <> "" Then
        If c = ComboBox24.Text Then
            ComboBox1.Text = c.Offset(0, 1)
            'TextBox5.Text = c.Offset(0, 3)
        End If
    End If
Next c
If ComboBox1.Text = "" Then
    ComboBox24.Text = ""
End If
End Sub

در یه کامند باتون نیز نوشتم کمبوها را خالی بکنه("")
سیستم در حدود یک دقیقه دور خودش می چرخه . بعضا error میده و بعضا هم اشکالی پیش نمیاد ولی زمان چرخیدنش زیاد هست چطور می تونم این قضیه رو حل کنم ممنون میشم راهنمایی بفرمایید