Help Restructuring and Shortening Some Excel VBA Code 1

[JasonEnsor]

Hi All,

I was wondering if anyone had any ideas on how I can reduce the mammoth amount of code I have listed below. The idea is for me to compare a value in a textbox against the value of a label control then if they match update a combo box. The code does work but there is a lot of repetition.

For each month that is selected from a separate combo box I calculate the weeks in the month ( so 4 or 5 weeks depending on month) I calculate the date of each Sunday in that month and put that data in to the label controls (LblWeek1,LblWeek2 etc..)

User's holidays populate 8 textboxes from data in the Spreadsheet (txtHol1, txtHol2 etc..) So I compare the holiday value against the label value on a weekly basis. so if the user has a holiday on 2nd Sept 2012, which is the first Sunday of the month then that will match up with the label control LblWeek1 therefore the combo box (cmbW1) should change to 'PH'.

I think that makes sense, as I say the code works but it's rather lengthy and full of repetition.

Any help is appreciated as always.

Kind Regards

Jason

' Week 1
    
    If (StrComp(NewPaymentForm.txtHol1.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol2.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol3.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol4.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol5.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol6.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol7.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol8.Value, NewPaymentForm.LblWeek1.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW1.Value = "PH"
    End If

    ' Week 2
    If (StrComp(NewPaymentForm.txtHol1.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol2.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol3.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol4.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol5.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol6.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol7.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol8.Value, NewPaymentForm.LblWeek2.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW2.Value = "PH"
    End If
    
    ' Week 3
    If (StrComp(NewPaymentForm.txtHol1.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol2.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol3.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol4.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol5.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol6.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol7.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol8.Value, NewPaymentForm.LblWeek3.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW3.Value = "PH"
    End If
    
    'Week 4
    If (StrComp(NewPaymentForm.txtHol1.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol2.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol3.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol4.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol5.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol6.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol7.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol8.Value, NewPaymentForm.LblWeek4.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW4.Value = "PH"
    End If
     If NumWeeks > 4 Then
     
    'Week 5
    If (StrComp(NewPaymentForm.txtHol1.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol2.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol3.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol4.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol5.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol6.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol7.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If
    If (StrComp(NewPaymentForm.txtHol8.Value, NewPaymentForm.LblWeek5.Caption, vbTextCompare) = 0) Then
        NewPaymentForm.cmbW5.Value = "PH"
    End If

 

[mintjulep]

Use two loops to build your StrCop arguments.

 

[PHV]

A starting point:

For w = 1 To 5
  For h = 1 to 8
    If StrComp(NewPaymentForm.Controls("txtHol" & h).Value, NewPaymentForm.Controls("LblWeek" & w).Caption, vbTextCompare) = 0 Then
      NewPaymentForm.Controls("cmbW" & w).Value = "PH"
    End If
  Next
Next

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[JasonEnsor]

Thank you both for the replies.

PHV your solution worked perfectly on my first round of tests. I had considered using a loop but didn't know where to begin with it.

Thank you again.

J.