How to loop through column of cells and write to another column of cells

Question

In my workbook, I have several sheets of column data and I write to a target sheet with two column of concatenated data, and this work fine. My problem is I then loop through the first column of dates and try to write the day name in column 3 (for a pivot table). The code hangs after writing the first 50 or so cells (of 1240). The for loop contains the problem which seems to indicate a variable overflow of some kind. Here is my code:

Sub copycolumn()
Dim lastrow, erow As Integer
Dim I As Long
Dim data As String
Dim Assets As Variant
Dim Asset As Variant

With Sheets("Sheet1") 'Clear the existing sheet rows
 lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
 .Range(.Cells(2, 1), .Cells(lastrow, 1)).ClearContents
 .Range(.Cells(2, 2), .Cells(lastrow, 1)).ClearContents
 .Range(.Cells(2, 3), .Cells(lastrow, 1)).ClearContents
End With

Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")

For Each Asset In Assets   'copy each sheet's 2 col data to "sheet1" into 1 long column
 With Sheets(Asset)
 lastrow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)
 .Range(.Cells(2, 1), .Cells(lastrow, 1)).Copy 'date
 erow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
 Worksheets("Sheet1").Range("A" & erow).PasteSpecial xlPasteValues

 .Range(.Cells(2, 4), .Cells(lastrow, 4)).Copy 'data
 erow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
 Worksheets("Sheet1").Range("B" & erow).PasteSpecial xlPasteValues
End With
Next Asset

'goto sheet1 and put day name into column 4
Sheets("Sheet1").Activate 
lastrow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row
For I = 2 To lastrow 'DeS' hangs in this loop
  Cells(I, 3) = Format(Cells(I, 1), "dddd")
Next
Cells(lastrow, 4).Select

MsgBox "Copied" & vbTab & lastrow & vbTab & "Rows"
End Sub

Where am I going wrong? Seems like this should be straight forward.

Pᴇʜ · Accepted Answer · 2020-03-14T10:46:34.567

3 things I immediately see that could cause problems and should be fixed:

If you Dim lastrow, erow As Integer only erow is Integer but lastrow is Variant. In VBA you need to specify a type for every variable or it is Variant by default. Also Excel has more rows than Integer can handle so you need to use Long:
```
Dim lastrow As Long, erow As Long. 
```
Further I recommend always to use Long as there is no benefit in using Integer in VB.
Stop using .Activate and .Select. This is a very bad practice and leads into many errors. See How to avoid using Select in Excel VBA. Always reference your workbook and sheet directly. Make sure all Cells, Range, Rows and Columns objects have a reference to a worksheet. There are some without like Cells(I, 3) should be changed to something like Sheets("Sheet1").Cells(I, 3) or when using a With block to .Cells(I, 3).
You mix up Sheets and Worksheets in your entire code. Make sure you know the difference. All worksheets are sheets but sheets can be a worksheet or a chartsheet or …

So make sure you use Worksheets for worksheets would be much cleaner.

I recommend also not to repeat Worksheets("Sheet1") all the time. If your sheet name changes from Sheet1 to something usefull like MyRawData you need to change it everywhere. Better define a variable Dim wsData As Worksheet and Set wsData = ThisWorkbook.Worksheets("Sheet1") then you can use it like wsData.Range("A1")…

Try to fix these things and check if you still get stuck in the code. If this does not solve your issues edit your code in the question to the updated one. Try to figure out which line causes the issue and tell us which line it is.

A clean version of your code could look like:

Option Explicit 'make sure you use it in every module as first line to force proper variable declaration

Public Sub CopyColumn()
    Dim wsData As Worksheet 'name your sheet only once and set a reference using a variable
    Set wsData = ThisWorkbook.Worksheets("Sheet1")

    With wsData 'Clear the existing sheet rows
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        'the other 2 ClearContents are already covered by this one and therefore are not needed
        .Range(.Cells(2, 3), .Cells(LastRow, 1)).ClearContents
    End With

    Dim Assets As Variant
    Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")

    Dim Asset As Variant
    For Each Asset In Assets   'copy each sheet's 2 col data to "sheet1" into 1 long column
        With ThisWorkbook.Worksheets(Asset)
            LastRow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)
            .Range(.Cells(2, 1), .Cells(LastRow, 1)).Copy 'date

            Dim eRow As Long
            eRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            wsData.Range("A" & eRow).PasteSpecial xlPasteValues

            .Range(.Cells(2, 4), .Cells(LastRow, 4)).Copy 'data
            eRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Offset(1, 0).Row
            wsData.Range("B" & eRow).PasteSpecial xlPasteValues
        End With
    Next Asset

    'goto sheet1 and put day name into column 4
    LastRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Row

    Dim i As Long
    For i = 2 To LastRow 'DeS' hangs in this loop
        wsData.Cells(i, 3).Value = Format$(wsData.Cells(i, 1), "dddd")
    Next i

    'jump to the last row
    wsData.Activate
    wsData.Cells(LastRow, 4).Select 'not needed if you don't want explicitly the user to see this

    MsgBox "Copied" & vbTab & LastRow & vbTab & "Rows", vbInformation, "Copy Rows"
End Sub

Note that I did not dig into the process of what the code does. I just checked the coding style and fixed the syntax where things could obviously go wrong.

The closer you follow a nice formatting and a good coding style the less errors you will get. Even if it looks sometimes a bit more work, in the end you will save a lot of time not seraching for strange issues.

Further thoughts

This line

Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")

looks like you will need to dig into the code 2021 again and add "Water 2021" because your code stopped working.

Avoid to write code that needs to get adjusted every year. My recommendation would be to loop through all worksheets and check if their name matches "Water ####" to run the code on them:

Dim Asset As Worksheet
For Each Asset In ThisWorkbook.Worksheets
    If Asset.Name Like "Water ####" Then
        'your code here …
    End If
End If

This will apply the code to every worksheet that is called "Water ####"

Thanks for the comments and time. The first half of the code pulls date and water value from each of the 5 worksheets and puts the two columns into sheet1. The second half with the problem attempts to put a day value into the third column of sheet1. The debugger ends up at the ‘next i’ line after a random number of successful lines, say 50,150,720. Never at the same line, which seems to point to a variable overflow, hence int to long makes sense. I’ll implement your suggestions and give it a try. — user50506, Mar 13 '20 at 22:00
@user50506 note that if there is an overflow you would get an error message. If Excel looks like freezed that means the code is still running. — Pᴇʜ, Mar 14 '20 at 10:49
My original code ran as does the cleaned up version. It just runs very very slow. I put a progress bar inside the loop and it is running! I may have some corruption so I saved-as to a new name. Also, the script writes to a dynamic named range that is input to 3 PivotTables. I need to find a way to stop calculations during execution. As an experiment, I copied the data sheets to a new file (no charts, PivotTables, etc) and copied the code and it runs very fast, as expected. — user50506, Mar 29 '20 at 07:10
then just set `Application.Calculation` to manual calulation and in the end set it back to automatic. Just search here on SO there should be some examples. — Pᴇʜ, Mar 29 '20 at 12:23

How to loop through column of cells and write to another column of cells

1 Answers1

Further thoughts