Tidying up code

litestream

Active Member
Joined
Jul 24, 2006
Messages
323
Code:
    Range("C6").Select
    Selection.Cut Destination:=Range("D5")
    Range("C8").Select
    Selection.Cut Destination:=Range("D7")
    Range("C11").Select
    Selection.Cut Destination:=Range("D10")
    Range("C13").Select
    Selection.Cut Destination:=Range("D12")
    Range("C16").Select
    Selection.Cut Destination:=Range("D15")
    Range("C18").Select
    Selection.Cut Destination:=Range("D17")
    Range("C21").Select
    Selection.Cut Destination:=Range("D20")
    Range("C23").Select
    Selection.Cut Destination:=Range("D22")

I have to continue this code up to about 2000 lines. Is there anyway to tidy up the code bearing in mind that one line is 2 more than the one above then the next line is 3 more than that?

Any assistance would be greatly appreciated.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Try this.
Code:
For I = 1 To 10 
Range("C" & 1 + I * 5).Cut Destination:=Range("D" & I * 5)
Range("C" & 3 + I * 5).Cut Destination:=Range("D" & 2 + I * 5)
Next I
 
Upvote 0
Give this a try:
Code:
Dim Limit As Long
Dim c As Long
Dim flag As Boolean
Limit = Cells(Rows.Count, 3).End(xlUp).Row
flag = False
c = 6
While c <= Limit
    Cells(c, 3).Cut Destination:=Cells(c - 1, 4)
    If flag = False Then
        c = c + 2
        flag = True
        Else
            c = c + 3
            flag = False
    End If
Wend
 
Upvote 0
Code:
Dim rng As Range, x#
Set rng = Range([C6], [C65536].End(xlUp))
For x = 1 To rng.Cells.Count Step 5
    rng(x).Cut rng(x - 1, 2)
    rng(x + 2).Cut rng(x + 1, 2)
Next
 
Upvote 0
Similarly, how would I tidy up the following?
How do I refer to rows using For and Next loops?

Code:
    Rows("6:6").Select
    Selection.Delete Shift:=xlUp
    Rows("7:8").Select
    Selection.Delete Shift:=xlUp
    Rows("8:8").Select
    Selection.Delete Shift:=xlUp
    Rows("9:10").Select
    Selection.Delete Shift:=xlUp
    Rows("10:10").Select
    Selection.Delete Shift:=xlUp
    Rows("11:12").Select
 
Upvote 0
Perhaps like this?:
Code:
Dim Limit As Long
Dim c As Long
Limit = Cells(Rows.Count, 1).End(xlUp).Row
For c = Limit To 6 Step -1
    If (c / 3) = Int(c / 3) Or ((c + 1) / 3) = Int((c + 1) / 3) Then
        Rows(c).Delete shift:=xlUp
    End If
Next c
 
Upvote 0
Code:
Dim rng As Range, x#, rng2 As Range
Set rng = Intersect([A6:A65536], ActiveSheet.UsedRange.EntireRow)
Set rng2 = rng(1)
For x = 6 To rng.Cells.Count Step 5
    Set rng2 = Union(rng2, rng(x))
Next
For x = 3 To rng.Cells.Count Step 5
    Set rng2 = Union(rng2, rng(x).Resize(2))
Next
rng2.EntireRow.Delete
 
Upvote 0

Forum statistics

Threads
1,213,552
Messages
6,114,278
Members
448,559
Latest member
MrPJ_Harper

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top