1

So I have a problem that this is generating random results with the Qty.

I am trying to make each qty (in their qty's) a new line on a new spreadsheet.

It creates the new sheet, and references the old sheet... the code copies and pastes the lines... It just doesn't loop the do while in the correct amount of times. I have tried different operands (>= 0) and altering the variable values to make this work.

It does not seem to be patternized as to why it is happening. Sometimes it does it in the correct amount of loop cycles, others it does not. This occurs on multiple values. Any help is greatly appreciated.

Sub copyPasta()
'
' copyPasta Macro
' This will take the qty, if greater than one  in Column C and copy the row 
'to a new sheet the amount of time the qty.
'
'
'Set Variable Types
Dim lineItemQty As Integer
Dim newLineItemQty As Integer
Dim LastRow As Integer
Dim strSheetName As String
Dim newSheetName As String
Dim i As Integer

Application.DisplayAlerts = False

'name a variable after the existing active sheet
strSheetName = ActiveSheet.Name
'add a sheet in addition to the current
Sheets.Add After:=ActiveSheet
'set a variable used in loops to the sheet being copied to
newSheetName = ActiveSheet.Name
'Return to first sheet
Sheets(strSheetName).Activate
' Set For Loop to max row
LastRow = Sheets(strSheetName).Range("C:C").Find("*", searchdirection:=xlPrevious).Row

'for loop to run through all rows
For i = 3 To LastRow Step 1

    'initializing variable to Qty value in table
    lineItemQty = Range("C" & i).Value

    'initializing variable within in line of for looping
    newLineItemQty = lineItemQty

    'do while loop to keep copying/pasting while there are still qty's
        Do While newLineItemQty > 0

        'do while looped copy and paste
            'copy the active row
                Sheets(strSheetName).Activate
                Rows(i).Select
                Selection.Copy
            'paste active row into new sheet
                Sheets(newSheetName).Select
                Rows("3:3").Select
                Selection.Insert Shift:=xlDown


            newLineItemQty = newLineItemQty - 1

        Loop
Next i

Application.DisplayAlerts = True

End Sub
  • I believe the creation of a new worksheet is not the problem, that works just as planned. The error is in the loops somewhere. Yes, starting at line 3 (there is a header and a gap in the lines (SQL report out formatting that I can't change). This will then run 'n' amount of times, for each line being copied 'm' copies into the new worksheet, where m = the qty in column C. – Ryland Moyar Nov 26 '18 at 19:17

1 Answers1

0

You can consider using (or taking parts from) the below alternative. A couple of note worthy notes are

  1. You should avoid using .Select and .Activate. See here for details
  2. Life is easier when you declare short variables. Here we just have ws for worksheet and ns for newsheet. You then need to actively state what sheet you are refferring to in your code (instead of using .Select or .Activate to do so by prefixing all objects with the appropriate worksheet variable)
  3. You do not need to add Step 1 in your loop. This is the default - you only need to add this when you are deviating from the default!
  4. There are a few ways to add sheets. Nothing wrong with the way you did - here is just an alternative (yay learning) that happens to be my preferred method.
  5. To copy n many times, just create a nested loop and for 1 to n. Notice we never really use the variable n inside the loop which means the exact same operation will execute, we just want it to execute n times.

Sub OliveGarden()

Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet
Dim ns As Worksheet: Set ns = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
    ns.Name = ws.Name & " New"

Dim i As Long, c As Long

'Application.ScreenUpdating = False
For i = 3 To ws.Range("C" & ws.Rows.Count).End(xlUp).Row
    If ws.Range("C" & i) > 0 Then
        For c = 1 To ws.Range("C" & i)
            LRow = ns.Range("A" & ns.Rows.Count).End(xlUp).Offset(1).Row
            ws.Range("C" & i).EntireRow.Copy
            ns.Range("A" & LRow).PasteSpecial xlPasteValues
        Next c
    End If
Next i
'Application.ScreenUpdating = True

End Sub
urdearboy
  • 14,439
  • 5
  • 28
  • 58
  • I agree that would work as a single level loop. I apologize for my inability to communicate this issue... for instance... if you have a table of data that is 56 rows... and each column C value is 1, 2, 3, 4, 5, 6, etc.... I need the program to copy and insert a line 1 time for a qty of 1, 2 times for a qty of 2, 3 for 3, n for nth. This would then happen 56 times. It would run the first loop 56 times, and the second nested loop 1596, but would have reset that each time it is starting the second nest level. - I am not sure that makes anything more clear? – Ryland Moyar Nov 26 '18 at 19:29
  • Also, I have updated to not include the .Select and .Activate. VERY good direction on cleaning up variables and organizing code (sometimes I get sloppy when pressured like this, and that should always be a focus). I wrote all the comments in an attempt to allow the code to speak as well. I believe the comments indicate what I intended to happen. – Ryland Moyar Nov 26 '18 at 19:32
  • Currently trying to frankenstein some sort of blend between my original and the link provided: https://stackoverflow.com/questions/20805874/excel-vba-copy-and-paste-loop-within-loop?rq=1 – Ryland Moyar Nov 26 '18 at 19:34
  • Okay, let me make is simpler... There are two rows in a worksheet. I need to take the first row (where value C = 3) and copy that in row 1, 2, and 3 (duplicate it) in a new worksheet. I then need to take the second row (where row value of c = 'n'), and copy that in row 1, 2, 3, 4, ..., 'n'. – Ryland Moyar Nov 26 '18 at 19:40
  • @RylandMoyar double check you grabbed the most recent code. I updated it 2x. I tested this and it is working. You need to make sure the correct sheet is `Active`before starting the code though. – urdearboy Nov 26 '18 at 19:41
  • And this takes the entire row and copies it? I am having some issues when running that it doesn't insert a new line (it hangs up and has '1' in row 1, column C) – Ryland Moyar Nov 26 '18 at 19:46
  • Is this a table or a range? – urdearboy Nov 26 '18 at 19:47
  • Just an FYI, I GREATLY appreciate the effort you are putting into this. This is one heck of a code you got going there, and I feel we are very close (way more elegant than my meager abilities could put out). – Ryland Moyar Nov 26 '18 at 19:47
  • So, I think the only thing that is still going on is, it needs to repetitively insert the line that is copied. – Ryland Moyar Nov 26 '18 at 19:51
  • Just as an update: I am giving you the solution, and again thank you for everything! If you wouldn't mind altering the code to reflect the following (solved the copy/paste/insert/etc. problem). For c = 1 To ws.Range("C" & i) ws.Range("C" & i).EntireRow.Copy ns.Range("1:1").Insert Shift:=xlDown Next c End If Next i End Sub – Ryland Moyar Nov 26 '18 at 20:15