Excel VBA Do until Column E

Question

I have a code for copying Range(D9:E31) with all the formatting and borders, also merged cells (D9:E9). Once user is pressing button Range(D9:E31) is copied to next available cells Range(F9:G31), Range(H9:I31) etc.

I have developed a code for deleting copied cells in reverse order Range(H9:31), Range(F9:G31)... However my core data is located in Range(D9:E31) so it should not be deleted in any circumstances.

How to make my code run until Column E. Once it reaches Column E it should stop working and button should do nothing no matter how many times it is pressed. I can add warning message myself later.

I have tried Do Until with no success. However I do not need to loop until Column E. I need to run VBA each time I press the button. By using loop it will delete everything until Column E? Maybe in this case If should be used? If next cell is not in Column E then run the code?

My code:

        Sub Remove()
    With Worksheets("Price calculation")
'Do Until Columns(4)
        lc = .Cells(9, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(9, lc - 0), .Cells(9, lc)).MergeArea.UnMerge
        lc = .Cells(11, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(9, lc - 1), .Cells(31, lc)).ClearContents
        .Range(.Cells(9, lc - 1), .Cells(31, lc)).Interior.ColorIndex = 2
        .Range(.Cells(9, lc - 1), .Cells(31, lc)).Borders.LineStyle = xlNone
    End With
    End Sub

Answer 1

ClearContents of Merged Columns

Since it is unclear if you want to delete all or one by one I've included both.

One-By-One

Every time you run this, the last 2-column range is 'removed', if any.

Sub RemoveOneByOne()
    Dim lc As Integer
    With Worksheets("Price calculation")
        lc = .Cells(9, .Columns.Count).End(xlToLeft).Column + 1
        If lc > 5 Then
            With .Range(.Cells(9, lc - 1), .Cells(31, lc))
                .UnMerge
                .ClearContents
                .Interior.ColorIndex = 2
                .Borders.LineStyle = xlNone
            End With
        End If
    End With
End Sub

---

All

Every time you run this, all 2-column ranges are 'removed', if any.

Sub RemoveAll()
    Dim lc As Integer
    With Worksheets("Price calculation")
        lc = .Cells(9, .Columns.Count).End(xlToLeft).Column + 1
        With .Range(.Cells(9, 6), .Cells(31, lc))
            .UnMerge
            .ClearContents
            .Interior.ColorIndex = 2
            .Borders.LineStyle = xlNone
        End With
    End With
End Sub

Answer 2

Try

Sub Remove()


    With Worksheets("Price calculation")
    'Do Until Columns(4)
        Do
            lc = .Cells(9, .Columns.Count).End(xlToLeft).Column

            If lc <= 4 Then Exit Do

            .Range(.Cells(9, lc - 0), .Cells(9, lc)).MergeArea.UnMerge
            lc = .Cells(11, .Columns.Count).End(xlToLeft).Column
            .Range(.Cells(9, lc - 1), .Cells(31, lc)).ClearContents
            .Range(.Cells(9, lc - 1), .Cells(31, lc)).Interior.ColorIndex = 2
            .Range(.Cells(9, lc - 1), .Cells(31, lc)).Borders.LineStyle = xlNone
        Loop
    End With
End Sub