Can you guys help me to make this code shorter? and smarter i guess

Question

Hi guys I'm a newbie on this so don't expect much from the code. Just tryna to make it shorter. Thanks! The code was made on the recorder macro function and I was cleaning it as much as I could. May be a smarter code for this but, basically is just to divide on 500 from the A column

Columns("A:A").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A501:A1000").Cut
    Range("B:B").Select
    ActiveSheet.Paste
Range("A1001:A1500").Cut
    Range("C:C").Select
    ActiveSheet.Paste
Range("A1501:A2000").Cut
    Range("D:D").Select
    ActiveSheet.Paste
Range("A2001:A2500").Cut
    Range("E:E").Select
    ActiveSheet.Paste
Range("A2501:A3000").Cut
    Range("F:F").Select
    ActiveSheet.Paste
Range("A3001:A3500").Cut
    Range("G:G").Select
    ActiveSheet.Paste
Range("A3501:A4000").Cut
    Range("H:H").Select
    ActiveSheet.Paste
Range("A4001:A4500").Cut
    Range("I:I").Select
    ActiveSheet.Paste
Range("A4501:A5000").Cut
    Range("J:J").Select
    ActiveSheet.Paste
End Sub```

[How to Avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — BigBen, Mar 03 '20 at 22:06
Does this answer your question? [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — AMC, Mar 04 '20 at 01:00
Feel free to reference [this guide](https://stackoverflow.com/help/how-to-ask); Asking the right question correctly is sure to elicit more responses. It is often more helpful if you include at least a brief explanation along with your [minimal reproducible example](https://stackoverflow.com/help/minimal-reproducible-example). — JerodG, Mar 04 '20 at 01:27

score 0 · Accepted Answer · answered Mar 03 '20 at 22:11

0

Anytime you find yourself repeating code, you are probably missing a opportunity to loop.

lr represents the last used row in Column A
i represents the current row
c represents the current column

Sub Shorter_Better_Faster()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- UPDATE

Dim lr as Long, i As Long, c As Long

lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
c = 2

For i = 501 To lr Step 500
    ws.Range(ws.Cells(1, c), ws.Cells(500, c)).Value = ws.Range(ws.Cells(i, 1), ws.Cells(i + 500, 1)).Value
    c = c + 1
Next i

ws.Range("A501:A" & lr).ClearContents

End Sub

answered Mar 03 '20 at 22:11

urdearboy

14,439
5
28
58

im trying to run the code but it does nothing, any idea whats going on? – Francisco Salcido Mar 03 '20 at 22:21
Well the sheet name is the same "Sheet1" so doesnt need an update, also basically what I'm doing its getting around 3000 values on the column A and what i intend to do is to remove duplicates, then divide the 3000 into 500 each (A has to count 500, B has to count 500, C has to count 500). Sorry if i wasnt clear enough @urdearboy – Francisco Salcido Mar 03 '20 at 22:56
I tried again with the code that you updated it but still just runs and do nothing. Is there a way that you can help me or I can send you over like the copy of the doc so you can verify it? – Francisco Salcido Mar 03 '20 at 23:26
no problem I undestand. So you're able to divide the X ammount of values on column A into 500 for B C D E .. . .. ? like if you have 1234..1000 youll have 1-500 on A and 501-1000 on B? – Francisco Salcido Mar 03 '20 at 23:37
I may have discovered the error, when I changed the "Sheet1" to "Test" and updated that on the code, theres a debug error (Subscript out of range), i know thats not supposed to happen. Any idea on this? – Francisco Salcido Mar 03 '20 at 23:42
Thank you! I was able to find the error. Was on ThisWorkbook, had to change it to ActiveWorkbook, Im sorry I wasnt specific about this. But I do appreaciate the time you took to fix my problem man. Thanks. – Francisco Salcido Mar 03 '20 at 23:56

Can you guys help me to make this code shorter? and smarter i guess

1 Answers1