Excel VBA Loop Bug

Question

I have a sheet that is being used to create what is eventually a text doc for HTML, but that starts in Excel. It could have anywhere from 1 - hundreds of items on it, then each item must have three fields (SKU, Description, Category), then two optional (Bullet, Image).

It will go like this. Sheet1 A2 copies to Sheet2 A2 Sheet2 B2 = "Description" Sheet1 B2 (The description data) copies to Sheet2 C2 Sheet1 A2 recopies to a new line on Sheet2 A3 Sheet2 B3 = "Category" Sheet1 C2 (Category data) copies to Sheet2 C3

Those are the mandatory fields. From there.

If Sheet 1 D2 (Bullet data) is populated then Sheet1 A2 copies to Sheet2 A4 Sheet2 B4 = "Bullet" Sheet1 D2 copies to Sheet2 C4

If Sheet 1 E2 (Image data) is populated, then Sheet1 A2 Copies to Sheet2 A5 Sheet2 B5 = "IMAGE" Sheet1 E2 copies to Sheet2 C5

That takes care of first line of Sheet 1. From there, I want it to loop through each row in sheet 1 column A until it gets to an empty cell in A.

Here is what I wrote. The first part works. But it's the loop (Commented block portion) that stumps me. I'm horrible at loops. Currently, it goes into a never-ending loop until I stop it.

Any guidance will be hugely appreciated. Thanks.

Sub MigrateToTemplate()

Dim NextSKU As Range
Set NextSKU = Worksheets("EAPData").Range("A2").Offset(1, 0)

Sheets("EAPData").Select
Range("A2").Select
ActiveCell.Copy
Sheets("TemplateTest").Select
Range("A2").Select
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.Offset(0, 1).Value = "DESCRIPTION"
ActiveCell.Offset(0, 2).Value = Sheets("EAPData").Range("C2").Value
ActiveCell.Offset(1, 0).Value = Sheets("EAPData").Range("A2").Value
ActiveCell.Offset(1, 1).Value = "CATEGORY"
ActiveCell.Offset(1, 2).Value = Sheets("EAPData").Range("E2").Value
    If Sheets("EAPData").Range("A2").Offset(0, 3) <> "" Then
    Sheets("EAPData").Range("A2").Offset(0, 3).Copy
    Range("A1").End(xlDown).Offset(1, 0).Select
    ActiveCell.Value = Range("A2").Value
    ActiveCell.Offset(0, 1).Value = "BULLET"
    ActiveCell.Offset(0, 2).PasteSpecial xlPasteValues
    ActiveCell = WorksheetFunction.Substitute(Selection, Chr(10), " ")
    Else
    Range("A1").End(xlDown).Select
    End If
If Sheets("EAPData").Range("A2").Offset(0, 5) <> "" Then
    Sheets("EAPData").Range("A2").Offset(0, 5).Copy
    Range("A1").End(xlDown).Offset(1, 0).Select
    ActiveCell.Value = Range("A2").Value
    ActiveCell.Offset(0, 1).Value = "IMAGE"
    ActiveCell.Offset(0, 2).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Else
    Sheets("EAPData").Select
    End If
Sheets("EAPData").Select
NextSKU.Select

'Do
'ActiveCell.Copy
'Sheets("TemplateTest").Select
'Range("A1").End(xlDown).Offset(1, 0).Select
'ActiveCell.PasteSpecial xlPasteValues
'ActiveCell.Offset(0, 1).Value = "DESCRIPTION"
'ActiveCell.Offset(0, 2).Value = NextSKU.Offset(0, 2).Value
'ActiveCell.Offset(1, 0).Value = NextSKU.Value
'ActiveCell.Offset(1, 1).Value = "CATEGORY"
'ActiveCell.Offset(1, 2).Value = NextSKU.Offset(0, 4).Value
'If NextSKU.Offset(0, 3) <> "" Then
'    NextSKU.Offset(0, 3).Copy
'    Range("A1").End(xlDown).Offset(1, 0).Select
'    ActiveCell.Value = NextSKU.Value
'    ActiveCell.Offset(0, 1).Value = "BULLET"
'    ActiveCell.Offset(0, 2).PasteSpecial xlPasteValues
'    ActiveCell = WorksheetFunction.Substitute(Selection, Chr(10), " ")
'    Else
'    Range("A1").End(xlDown).Select
'    End If
'If NextSKU.Offset(0, 5) <> "" Then
'    NextSKU.Offset(0, 5).Copy
'    Range("A1").End(xlDown).Offset(1, 0).Select
'    ActiveCell.Value = NextSKU.Value
'    ActiveCell.Offset(0, 1).Value = "IMAGE"
'    ActiveCell.Offset(0, 2).PasteSpecial xlPasteValues
'    Application.CutCopyMode = False
'    Else
'    Sheets("EAPData").Select
'    End If
'Sheets("EAPData").Select
'NextSKU.Offset(1, 0).Select
'Loop While NextSKU.Offset(1, 0) <> ""

End Sub

First, you should avoid using Select: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros Second, You could use lastRows to make a for loop, like: https://stackoverflow.com/questions/29653616/how-to-know-the-last-row-filled-in-vba-excel — danieltakeshi, Jun 21 '17 at 17:54
`Sub MigrateToTemplate() Dim EAP, TTest As Worksheet Dim i As Integer Dim a2 As String Set EAP = ThisWorkbook.Worksheets("EAPData") Set TTest = ThisWorkbook.Worksheets("TemplateTest") lastRow = Range("A65536").End(xlUp).Row 'Copy from Sheet1 to Sheet2 a2 = EAP.Cells(2, 1).Value TTest.Cells(2, 1).Value = a2 'Insert Titles TTest.Cells(2, 2).Value = "Description" For i = 1 To lastRow If EAP.Cells(2, 4).Value <> "" Then 'Make something End If Next i End Sub` Example to help — danieltakeshi, Jun 21 '17 at 18:16

score 1 · Answer 1 · answered Jun 21 '17 at 18:03

Of course your loop will go on forever. Please be sure to try debugging your code before putting it up on SO. Note that I have only removed lines that are working with the sheet, and range. See below:

Do
    ' Copy cell, then write some values

    If NextSKU.Offset(0, 3) <> "" Then
        ' Copy some more cells and write values
    Else
        ' Change the selection
    End If

    If NextSKU.Offset(0, 5) <> "" Then
        ' Copy and Write
    Else
        ' Change Sheet selection
    End If

    ' Change Range and Sheet Selection

' And right here is the key to your problem.
' Notice that you have only changed values on the sheet,
' as well as the selection, but never 'NextSKU'
Loop While NextSKU.Offset(1, 0) <> ""

This problem is easy to avoid in two ways. First, make sure you have some kind of control variable that allows for iteration. By this I mean, you should either use a counter (for i = X to Y) or you should use a collection (for each X in Y). You can use a while loop for this, but you must change the variable that the while is pointed at.

I strongly encourage you to learn how to avoid using Select, Activate, Etc. This code will be inefficient and error prone.

Excel VBA Loop Bug

1 Answers1