How to refactor long loops?

Question

It is my first post on this forum and I am pleased I've found it. I've already used lots of tips from the website to help me with my projects and I would call myself as beginner-intermediate VBA developer.

I have created loop which exports data for further filtering and it works perfect but it is very, very long. Is there any way to make the below code shorter and more pleasant to an eye and keep the functionality?

Short about the code and what it does:

It exports data from one spreadsheet which has data organized in kind of a pattern, but this pattern doesn't let me use filters so I created export macro to break the pattern and put data in columns.

Thank you in advance for any help or suggestions.

'export
Dim rownumber As Double
rownumber = 2

Rev.Activate
Rev.Range("A13").Select

Do Until IsEmpty(ActiveCell.Offset(4, 0))

Exp.Range("A" & rownumber).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 1).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 2).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 3).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 4).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 5).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 6).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 7).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 8).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 9).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 10).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 11).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 12).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 13).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 14).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 15).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 16).Value = ActiveCell.Value


Exp.Range("A" & rownumber).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 1).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 2).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 3).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 4).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 5).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 6).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 7).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 8).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 9).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 10).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 11).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 12).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 13).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 14).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 15).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 16).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

Exp.Range("B" & rownumber).Value = "Q1"
Exp.Range("B" & rownumber + 1).Value = "Q2"
Exp.Range("B" & rownumber + 2).Value = "Q3"
Exp.Range("B" & rownumber + 3).Value = "Q4"
Exp.Range("B" & rownumber + 4).Value = "A"
Exp.Range("B" & rownumber + 5).Value = "Jan"
Exp.Range("B" & rownumber + 6).Value = "Feb"
Exp.Range("B" & rownumber + 7).Value = "Mar"
Exp.Range("B" & rownumber + 8).Value = "Apr"
Exp.Range("B" & rownumber + 9).Value = "May"
Exp.Range("B" & rownumber + 10).Value = "Jun"
Exp.Range("B" & rownumber + 11).Value = "Jul"
Exp.Range("B" & rownumber + 12).Value = "Aug"
Exp.Range("B" & rownumber + 13).Value = "Sep"
Exp.Range("B" & rownumber + 14).Value = "Oct"
Exp.Range("B" & rownumber + 15).Value = "Nov"
Exp.Range("B" & rownumber + 16).Value = "Dec"

Exp.Range("B" & rownumber).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 1).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 2).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 3).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 4).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 5).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 6).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 7).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 8).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 9).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 10).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 11).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 12).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 13).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 14).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 15).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 16).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

Exp.Range("C" & rownumber).Value = ActiveCell.Offset(0, 19).Value
Exp.Range("C" & rownumber + 1).Value = ActiveCell.Offset(0, 20).Value
Exp.Range("C" & rownumber + 2).Value = ActiveCell.Offset(0, 21).Value
Exp.Range("C" & rownumber + 3).Value = ActiveCell.Offset(0, 22).Value
Exp.Range("C" & rownumber + 4).Value = ActiveCell.Offset(0, 24).Value
Exp.Range("C" & rownumber + 5).Value = ActiveCell.Offset(0, 3).Value
Exp.Range("C" & rownumber + 6).Value = ActiveCell.Offset(0, 4).Value
Exp.Range("C" & rownumber + 7).Value = ActiveCell.Offset(0, 5).Value
Exp.Range("C" & rownumber + 8).Value = ActiveCell.Offset(0, 6).Value
Exp.Range("C" & rownumber + 9).Value = ActiveCell.Offset(0, 7).Value
Exp.Range("C" & rownumber + 10).Value = ActiveCell.Offset(0, 8).Value
Exp.Range("C" & rownumber + 11).Value = ActiveCell.Offset(0, 9).Value
Exp.Range("C" & rownumber + 12).Value = ActiveCell.Offset(0, 10).Value
Exp.Range("C" & rownumber + 13).Value = ActiveCell.Offset(0, 11).Value
Exp.Range("C" & rownumber + 14).Value = ActiveCell.Offset(0, 12).Value
Exp.Range("C" & rownumber + 15).Value = ActiveCell.Offset(0, 13).Value
Exp.Range("C" & rownumber + 16).Value = ActiveCell.Offset(0, 14).Value

Exp.Range("D" & rownumber).Value = ActiveCell.Offset(1, 19).Value
Exp.Range("D" & rownumber + 1).Value = ActiveCell.Offset(1, 20).Value
Exp.Range("D" & rownumber + 2).Value = ActiveCell.Offset(1, 21).Value
Exp.Range("D" & rownumber + 3).Value = ActiveCell.Offset(1, 22).Value
Exp.Range("D" & rownumber + 4).Value = ActiveCell.Offset(1, 24).Value
Exp.Range("D" & rownumber + 5).Value = ActiveCell.Offset(1, 3).Value
Exp.Range("D" & rownumber + 6).Value = ActiveCell.Offset(1, 4).Value
Exp.Range("D" & rownumber + 7).Value = ActiveCell.Offset(1, 5).Value
Exp.Range("D" & rownumber + 8).Value = ActiveCell.Offset(1, 6).Value
Exp.Range("D" & rownumber + 9).Value = ActiveCell.Offset(1, 7).Value
Exp.Range("D" & rownumber + 10).Value = ActiveCell.Offset(1, 8).Value
Exp.Range("D" & rownumber + 11).Value = ActiveCell.Offset(1, 9).Value
Exp.Range("D" & rownumber + 12).Value = ActiveCell.Offset(1, 10).Value
Exp.Range("D" & rownumber + 13).Value = ActiveCell.Offset(1, 11).Value
Exp.Range("D" & rownumber + 14).Value = ActiveCell.Offset(1, 12).Value
Exp.Range("D" & rownumber + 15).Value = ActiveCell.Offset(1, 13).Value
Exp.Range("D" & rownumber + 16).Value = ActiveCell.Offset(1, 14).Value

rownumber = rownumber + 17
ActiveCell.Offset(4, 0).Select

Loop

GTPV · Accepted Answer · 2018-11-13T15:16:01.857

First, excel is really good at handling multiple rows simultaneously.

All of your block are basically carrying over format and values of one range into another range.

This can be done with the following type of logic:

Exp.range("A1:D16").value = AnotherRange.value

So, there are a few things that you can do to improve your loop. Almost all of your blocks can be rewritten in a more concise form. For instance:

Exp.Range("B" & rownumber).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 1).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 2).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 3).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 4).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 5).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 6).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 7).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 8).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 9).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 10).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 11).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 12).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 13).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 14).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 15).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 16).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

Can be rewritten as a one liner:

Exp.Range(Exp.cells(rownumber,2),Exp.cells(rownumber+16,2)).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

You can also assign an array to a range:

dim headerArray as variant: headerArray = Array(Array("Q1", "Q2", "Q3", "Q4", "A", "Jan","Feb", "Mar","Apr","May","Jun","Jul", "Aug","Sep","Oct","Nov","Dec"))
Exp.Range(Exp.cells(rownumber,2),Exp.cells(rownumber+16,2)).value = Application.Transpose(headerArray)

Thank you for the suggestion, it shortened the code a little bit, but the last part is not working for me as it populates Q1 for the whole column. — wisniadj, Nov 13 '18 at 15:11
@wisniadj don't forget to mark it as answered if it solved your problem. — GTPV, Nov 14 '18 at 14:35

score 2 · Answer 2 · answered Nov 13 '18 at 11:42

You can use resize to cut the repeated blocks of 17 lines down to 1 e.g.

Range("A" & rowNumber).Resize(17, 1) = ActiveCell.Value

This doesn't apply where the values on the right hand side vary (e.g. with "Q1")

I would strongly advise fully qualifying ranges with parent sheet names and avoiding ActiveCell where possible. Loop an explicit range with a For Each loop using step 17 or whatever the appropriate step count is.

See the avoiding .Select for help with removing your .Select and alternative syntax/code structure.

How to refactor long loops?

2 Answers2