Help cleaning up some code if you please

[EssKayKay]

Hello,
This is no biggie here - really just wondering if there is a more efficient way to code this (my programming skills are very limited to say the least).

I have three routines that basically do the same thing to three sets of cells. I simply copied the code from the first set; then edit it for the next two. It appears to be doing what I want. However, I suspect there is a better way to achieve this.

I don’t expect anyone to spend much time on this but if it looks easy enough to clean up, I would be interested.

Here’s my code –

‘- - - 1st One-Time - - -
     If Range("K8:K9").Locked = False And Range("K9") = "" Then
          MsgBox " Missing One-Time Amount" & vbNewLine & " Re-enter Payment details.", , " One-Time Pmt."
          Range("K8,K9").Select
          Selection.ClearContents
          Range("K9").Select
          Selection.Locked = True
          With Selection.Interior
              .Color = 15984868
         End With
         Range("K8").Select
         Exit Sub
End If


‘- - - 2nd One-Time - - -
     If Range("K10:K11").Locked = False And Range("K11") = "" Then
          MsgBox " Missing One-Time Amount" & vbNewLine & " Re-enter Payment details.", , " One-Time Pmt."
          Range("K10,K11").Select
          Selection.ClearContents
          Range("K11").Select
          Selection.Locked = True
          With Selection.Interior
              .Color = 15984868
          End With
          Range("K10").Select
          Exit Sub
     End If

‘- - - 3rd One-Time - - -
     If Range("K12:K13").Locked = False And Range("K13") = "" Then
          MsgBox " Missing One-Time Amount" & vbNewLine & " Re-enter Payment details.", , " One-Time Pmt."
          Range("K12,K13").Select
          Selection.ClearContents
          Range("K13").Select
          Selection.Locked = True
          With Selection.Interior
              .Color = 15984868
          End With
          Range("K12").Select
     Exit Sub
End If

Thanks for viewing,
Steve

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim x As Long
    For x = 8 To 12 Step 2
        If Range("K" & x & ":K" & x + 1).Locked = False And Range("K" & x + 1) = "" Then
            MsgBox " Missing One-Time Amount" & vbNewLine & " Re-enter Payment details.", , " One-Time Pmt."
            Range("K" & x & ":K" & x + 1).ClearContents
            With Range("K" & x + 1)
                .Locked = True
                .Color = 15984868
            End With
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

[NateSC]

I had a similar solution to mumps (and I stole a few simplifications as well), but it allows you to set the first row (myRowBase). I did add some extra variables (myCell1 and myCell2) just for clarity and troubleshooting.

Sub test()
Dim myRowBase As Integer
Dim myCell1 As String
Dim myCell2 As String

myRowBase = 8
For i = 0 To 2
    myCell1 = "K" & myRowBase + 2 * i
    myCell2 = "K" & myRowBase + 2 * i + 1
    If Range(myCell1 & ":" & myCell2).Locked = False And Range(myCell2) = "" Then
        MsgBox " Missing One-Time Amount" & vbNewLine & " Re-enter Payment details.", , " One-Time Pmt."
        Range(myCell1 & ":" & myCell2).ClearContents
        With Range(myCell2)
            .Locked = True
            .Interior.Color = 15984868
        End With
        Range(myCell1).Select
        Exit Sub
    End If
Next i

End Sub

 

[EssKayKay]

Thank you Mumps for your quick response. I placed your code in my worksheet. The routine is Triggered via a command button. When I clicked on it I received a Run-time error ‘438’. It hangs on the .Color = 15984868.

Here are the two messages:



Thanks,
Steve

 

[rlv01]

Instead of

.Color = 15984868

try

.Interior.Color = 15984868

 

[EssKayKay]

Instead of

.Color = 15984868

try

.Interior.Color = 15984868

That did it. Once again, thank you - much appreciated,
Steve K.

 

[EssKayKay]

OOPS. . .
I did notice one small issue. I have a bit more testing, particularly for the third run. I will get back to you on this (I have another appointment this afternoon).

Once again, thank you - much appreciated,
Steve K.

 

[EssKayKay]

We (read you) are very close. However, this process is the first of other operations taking place in the Sub (cmdPmtMade_Click).

What happens is if the second cell is left blank (i.e., K9, K11, or K13), after the “Missing One-Time” Message appears, the remainder of the Sub is processes. What I was hoping for is if the message appears, then stop the remainder of the Sub and return to the first cell in the set (i.e., K8, K10, or K12).

Thank you all,
Steve K

 

[rlv01]

hat I was hoping for is if the message appears, then stop the remainder of the Sub

Give @NateSC's code a try for this.

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim x As Long
    For x = 8 To 12 Step 2
        If Range("K" & x & ":K" & x + 1).Locked = False And Range("K" & x + 1) = "" Then
            MsgBox " Missing One-Time Amount" & vbNewLine & " Re-enter Payment details.", , " One-Time Pmt."
            Range("K" & x).Select
            Exit Sub
        End If
        Range("K" & x & ":K" & x + 1).ClearContents
        With Range("K" & x + 1)
            .Locked = True
            .Interior.Color = 15984868
        End With
    Next x
    Application.ScreenUpdating = True
End Sub