Loop Breaks On Range.Rows = 2 -- VBA

Question

I am continuing to expand on the functionality of sorting and organizing data pulled from a mainframe. This question is in regard to an expansion of functionality from this question's focus. The data is alphanumeric, and is similar to that found in this previously asked question.

I am attempting to permit users to use a list of 1 item in the criteria sheet of my dataset, as well as multiple items. My code is as follows:

'This subroutine is intended to take filtered data and use it to fill forms.
'These forms use a very basic text template worksheet, which is copied over for each worksheet.
'In general, these forms will number from 1 to 100, for discussion purposes.
'The idea is that each row of data in the DataSheet will be used to fill each worksheet tab.

Sub Shifter()


Dim RngOne As Range, RngCell As Range
Dim RngTwo As Range
Dim RngThree As Range, RngCell2 As Range 'RngCell2 is not currently in use
Dim RngRow As Range

Dim LastCell As Long

Dim arrList() As String, LongCount As Long

'Define range data within the Criteria Sheet
With Sheets("Criteria")
    LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row
    If LastCell <= 1 Then
        MsgBox ("Please do not leave the Criteria sheet blank. Note that all criteria belong under Column A.")
        Exit Sub
    ElseIf LastCell = 2 Then
        Set RngOne = .Range("A2")
    Else
        Set RngOne = .Range("A2:A" & LastCell)
    End If
End With

'Push values into the array
LongCount = 0
For Each RngCell In RngOne
    ReDim Preserve arrList(LongCount)
    arrList(LongCount) = RngCell.Text
    LongCount = LongCount + 1
Next


'Filter the values to the desired criteria stored in the array.
With Sheets("Sheet1")

LastSheetCellCheck = .Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Row
If LastCell <= 1 Then
    MsgBox ("Please do not leave the Criteria sheet blank. Note that all criteria belong under Column A.")
    Exit Sub
End If

Call ShiftToText
'For when this process is repeated.
If .FilterMode Then .ShowAllData

.Range("A:A").AutoFilter Field:=1, Criteria1:=arrList, Operator:=xlFilterValues

End With

'Add a Sheet to contain the filtered criteria
Sheets.Add After:=Sheets(1)
Sheets(2).Name = "DataSheet"

'With the original dataset, snag all existing data based on the range in Sheet Criteria.
'This avoids potential empty junk data and potential blanks pulled from the mainframe.
With Sheets("Sheet1")

LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row
Set RngTwo = .Range("A2:AA" & LastCell)

End With

'Push data into DataSheet worksheet, so data is sequential
Sheets(1).Select
RngTwo.Copy
Sheets("DataSheet").Select
ActiveSheet.Paste

'Define the ranges used within the sheet
With Sheets("DataSheet")

If LastCell = 2 Then

    Set RngThree = .Range("A2")

Else

    LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row
    Set RngThree = .Range("A2:A" & LastCell)

End If

End With

'For each row in the range, (1) generate a new datasheet, and copy the form from the template to the new sheet.
'(2) Rename the datasheet to be the value in Row 1, Column 1 ("A1").
'(3) Copy over information to the form based on column location in the Datasheet.
'This method, even if made functional, is both procedural and limited in scope. Recursion with text matching will be the end goal for this form.
For Each RngRow In RngThree.Rows

Sheets.Add After:=Sheets(1)

'Grab the text form from the Template and push it into the new sheet.
Sheets("TemplateSheet").Select
Cells.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Paste

Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value

Sheets(2).Range("B3").Value = Sheets("DataSheet").Cells(RngRow.Row, 1).Value

Sheets(2).Range("B5").Value = Sheets("DataSheet").Cells(RngRow.Row, 2).Value

Sheets(2).Range("D3").Value = Sheets("DataSheet").Cells(RngRow.Row, 3).Value

Sheets(2).Range("F3").Value = Sheets("DataSheet").Cells(RngRow.Row, 4).Value

Sheets(2).Range("B10").Value = Sheets("DataSheet").Cells(RngRow.Row, 5).Value

Sheets(2).Range("B7").Value = Sheets("DataSheet").Cells(RngRow.Row, 6).Value

Sheets(2).Range("D10").Value = Sheets("DataSheet").Cells(RngRow.Row, 7).Value

Sheets(2).Range("F10").Value = Sheets("DataSheet").Cells(RngRow.Row, 8).Value

Sheets(2).Range("B13").Value = Sheets("DataSheet").Cells(RngRow.Row, 9).Value

Sheets(2).Range("D13").Value = Sheets("DataSheet").Cells(RngRow.Row, 10).Value

Sheets(2).Range("F13").Value = Sheets("DataSheet").Cells(RngRow.Row, 11).Value

Sheets(2).Range("B16").Value = Sheets("DataSheet").Cells(RngRow.Row, 12).Value

Sheets(2).Range("D16").Value = Sheets("DataSheet").Cells(RngRow.Row, 13).Value

Sheets(2).Range("F16").Value = Sheets("DataSheet").Cells(RngRow.Row, 14).Value

Sheets(2).Range("B19").Value = Sheets("DataSheet").Cells(RngRow.Row, 15).Value

Sheets(2).Range("D19").Value = Sheets("DataSheet").Cells(RngRow.Row, 16).Value

Sheets(2).Range("F19").Value = Sheets("DataSheet").Cells(RngRow.Row, 17).Value

Sheets(2).Range("B21").Value = Sheets("DataSheet").Cells(RngRow.Row, 18).Value

Sheets(2).Range("D21").Value = Sheets("DataSheet").Cells(RngRow.Row, 19).Value

Sheets(2).Range("B23").Value = Sheets("DataSheet").Cells(RngRow.Row, 20).Value

Sheets(2).Range("D23").Value = Sheets("DataSheet").Cells(RngRow.Row, 21).Value

 'Concatenate values from certain fields into one field
Sheets(2).Range("A26").Value = Sheets("DataSheet").Cells(RngRow.Row, 23).Value & Cells(RngRow.Row, 24).Value & Cells(RngRow.Row, 24).Value & Cells(RngRow.Row, 25).Value & Cells(RngRow.Row, 26).Value & Cells(RngRow.Row, 27).Value


Next RngRow


End Sub

Currently, execution of the code results in a '1004' run-time error on line 106: Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value.

I avoid On Error Resume code blocks as much as possible, as I consider them to be a last resort, but I am at a bit of a dead-end, and could use aid/advice for an object oriented / general VBA solution.

EDIT

For additional clarification, adding the simple code

MsgBox (Sheets(2).Name)

after

Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value

returns the test value of "100-AAA" for "A2", at Rng.Rows = 1. Moreover, Test Sheets are removed at the beginning of the code execution by calling a delete script developed with this question. The code fails at Rng.Rows = 2.

Right. Sorry, you wrote that in your title. What is the value in `Sheets("DataSheet").Range("A2")` which is equivalent to `Sheets("DataSheet").Cells(RngRow.Row, 1).Value`? Is this value a valid value in which to name a sheet? — Scott Holtzman, Aug 13 '12 at 20:17
To add to @ScottHoltzman's question, do you already have a sheet with the same name? If this is the problem, then I'd recommend loading each of the values in your `Cells(RngRow.Row, 1)` into a `Collection` or `Scripting.Dictionary` first to avoid the duplicate-specific error. (You'll still have to figure out how you want to handle that scenario.) — Gaffi, Aug 13 '12 at 20:34
Yes @Gaffi that was my line of thinking. I was just trying to help the user learn how to "debug" going forward. — Scott Holtzman, Aug 13 '12 at 20:40
Also, generally speaking, when you get to the lines with multiple `Sheets("DataSheet").Cells(RngRow.Row, x)` steps, you could throw the whole range into an array, thereby improving the readability and likely the efficiency of your code. i.e. `Set Ary = Sheets("DataSheet").Rows(RngRow.Row)` / `Sheets(2).Range("B3").Value = Ary(1,2).Value` You can do the same to store all those values up front, then plug into your sheet later. I can expand on this more in an answer, if you like. — Gaffi, Aug 13 '12 at 20:44
Hello Scott, stepping into the subroutine and adding a message box, the value for A2 is 100-AAA (at RngRow = 1), which is my alphanumeric test value. — Scott Conover, Aug 13 '12 at 20:46
@Gaffi I do not have sheets with the same name, because I execute a script formed from this [question](http://stackoverflow.com/questions/11888291/deleting-worksheets-based-on-multiple-worksheet-criteria) I asked earlier. When I have a sheet with a duplicate name, that particular error is normally returned to me. — Scott Conover, Aug 13 '12 at 20:48
@Gaffi, yes, please, an answer would be very useful. I do extensive research and to form try a solution before I ask questions; my original intent was to use If Then statements with the value of LastCell as a conditional to resolve the issue by setting loop specific events. I admit as a novice that I find switching to VB from my other programming to be confusing for the time being, as VBA especially uses an unusual framework (at least to me) that I do not fully understand at times. — Scott Conover, Aug 13 '12 at 20:50
@Gaffi, No, I am using excel 2007. I will note that in my future posts. — Scott Conover, Aug 13 '12 at 21:08

Gaffi · Accepted Answer · 2012-08-14T14:14:25.817

I think I've found your answer...

In your code:

With Sheets("Sheet1")

LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row
Set RngTwo = .Range("A2:AA" & LastCell)

End With

'Push data into DataSheet worksheet, so data is sequential
Sheets(1).Select
RngTwo.Copy
Sheets("DataSheet").Select
ActiveSheet.Paste

You Set RngTwo = .Range("A2:AA" & LastCell), which means your header is not being included when pasted into DataSheet. Then below that, this block

If LastCell = 2 Then

    Set RngThree = .Range("A2")

Will not work, because you've only copied 1 row of data, thus A2 is blank. You may not have noticed, since there was no error, but this also means the case when the criteria are greater than 1 was always leaving out the first element in the list on DataSheet.

There are two solutions as I see it: Change the LastCell check to set the range starting at row 1:

If LastCell = 2 Then
    Set RngThree = .Range("A1") 'CHANGE THIS LINE
Else
    LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row
    Set RngThree = .Range("A1:A" & LastCell) 'CHANGE THIS LINE
End If

OR Set your copy range to include the first, header row:

With Sheets("Sheet1")

LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row
Set RngTwo = .Range("A1:AA" & LastCell) 'CHANGE THIS LINE

End With

'Push data into DataSheet worksheet, so data is sequential
Sheets(1).Select
RngTwo.Copy
Sheets("DataSheet").Select
ActiveSheet.Paste

For the record, I did test both the above options with both one and many criteria. All seemed to work just fine for me.

I hope this helps...

For posterity, it should be noted that the reason I cycle through A2 on for "Sheet1" is that it is the original datasheet with data pulled from the mainframe. Thus, it has header information which can be used by various persons for various purposes. It is effectively filtered and stripped out by copying A2 onward - below the header. Including the header would mean that I would need to refactor my loop so that I did not create a worksheet form filled with header information - although I can imagine cases where that could come in handy. — Scott Conover, Aug 14 '12 at 14:16
That should be fine. The first of my two suggestions will correctly handle the omission of the header line. :-) — Gaffi, Aug 14 '12 at 14:18
The solution which works best here is to set A2 to A1; I kept missing that since I had already removed the header information from "Sheet1" when it was copied to the worksheet "DataSheet", there was no need to cycle through A2 onward AGAIN in the new, copied over worksheet data. I imagine this would lead to a missing form as well, as my loop would complete early. I would not have noticed this, however, until I refactored later, as I am dealing with large amounts of form data. I planned to deal with refactoring when I ported to codereview.stackexchange, but thank you for catching that :). — Scott Conover, Aug 14 '12 at 14:20

Loop Breaks On Range.Rows = 2 -- VBA

1 Answers1

Linked