Paste Loop while value is negative

Question

I am trying to create a paste loop and want the loop to continue as long as the values within the column are negative and paste it to another workbook that the user will select. Also, I need to paste one range first before pasting another. And in the new workbook, I need to start pasting one cell down once it is finished with the 4oz loop to start with the 8oz loop.

Sub Absolute_Value() ' ' Absolute_Value Macro 'Defining Terms

Dim sht As Worksheet
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim nwbsht1 As Worksheet
Dim nwbsht2 As Worksheet
Dim nwbsht3 As Worksheet
Dim nwbsht4 As Worksheet
Dim nwbsht5 As Worksheet
Dim nwbsht6 As Worksheet
Dim nwbsht7 As Worksheet
Dim nwbsht8 As Worksheet
Dim rngToAbs As Range
Dim c As Range
Dim wb As Workbook
Dim nwb As Workbook
Dim Onhand As Range
Dim OnHand2 As Range
Dim OnHand1 As Range
Dim OnHand3 As Range
Dim Pallet As Range
Dim PalletType As Range
Dim Item As Range
Dim Item2 As Range
Dim UnitQty As Range
Dim CL As Range
Dim DL As Range
Dim OutputArray
Dim I As Long



'Setting ranges for PackPlan workbook
Set wb = Application.ActiveWorkbook

   With ActiveWorkbook.Worksheets("Arils Pack Plan ")
    Set rngToAbs = .Range("F7:F28")
    Set Item = .Range("B7:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    Set PalletType = .Range("E7:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
End With

'Opening Recent ATS report

With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
    .AllowMultiSelect = False
    .Show
Application.Workbooks.Open .SelectedItems(1)
Set nwb = Application.ActiveWorkbook

End With

'Setting Ranges for Daily Need Worksheet

'4oz Range Setting

Set nwb = Application.ActiveWorkbook
Set nwbsht1 = nwb.Sheets("DAILY NEED (DR)")
Set Onhand = nwbsht1.Range("Q5:Q14")

Set nwb = Application.ActiveWorkbook
Set nwbsht2 = nwb.Sheets("DAILY NEED (DR)")
Set Pallet = nwbsht2.Range("E5:E14")

Set nwb = Application.ActiveWorkbook
Set nwbsht3 = nwb.Sheets("DAILY NEED (DR)")
Set OnHand1 = nwbsht3.Range("U5:U14")

Set nwb = Application.ActiveWorkbook
Set nwbsht4 = nwb.Sheets("DAILY NEED (DR)")
Set OnHand2 = nwbsht4.Range("Y5:Y14")


'8oz Range Setting
Set nwb = Application.ActiveWorkbook
Set nwbsht5 = nwb.Sheets("DAILY NEED (DR)")
Set OnHand3 = nwbsht5.Range("Q15:Q25")

Set nwb = Application.ActiveWorkbook
Set nwbsht6 = nwb.Sheets("DAILY NEED (DR)")
Set Pallet = nwbsht6.Range("E15:E25")

Set nwb = Application.ActiveWorkbook
Set nwbsht7 = nwb.Sheets("DAILY NEED (DR)")
Set OnHand1 = nwbsht7.Range("T15:T25")

Set nwb = Application.ActiveWorkbook
Set nwbsht8 = nwb.Sheets("DAILY NEED (DR)")
Set OnHand2 = nwbsht8.Range("Y15:Y25")

'Copy and Paste Loop for Units

nwb.Activate

 I = 1
ReDim OutputArray(1 To Onhand.Cells.Count)
For Each CL In Onhand.Cells
    If CL.Value < 0 Then
        OutputArray(I) = CL.Value
        I = I + 1
    End If
Next CL

wb.Activate
wb.Sheets("Arils Pack Plan ").Range("F7").Resize(I, 1) = Application.Transpose(OutputArray)



nwb.Activate

ReDim OutputArray(1 To OnHand1.Cells.Count)
For Each DL In OnHand1.Cells
    If DL.Value < 0 Then
        OutputArray(I) = DL.Value
        I = I + 1
    End If
Next DL

wb.Activate
wb.Sheets("Arils Pack Plan ").Range("F7").Resize(I, 1) = Application.Transpose(OutputArray)

The For loop is missing the upper bound. Is this a typo? `For i = 1 to `. — Kostas K., Dec 16 '22 at 16:16
You have quite a bit of code there. Please look at https://stackoverflow.com/help/minimal-reproducible-example — dcromley, Dec 16 '22 at 17:48
You're assigning the same object to multiple variables - you only need to do that once for each object. — Tim Williams, Dec 16 '22 at 18:12
I'm sorry. I don't understand what you mean by assigning the same object to multiple variables. — Jonathan Anguiano, Dec 17 '22 at 15:32
Please check this URL: https://stackoverflow.com/questions/10714251 — Dominique, Dec 19 '22 at 08:40

Tim Williams · Answer 1 · 2022-12-19T06:41:39.153

As a clarification from my comment about setting multiple varaibles to the same object...

Instead of this:

   'Setting ranges for PackPlan workbook
   Set wb = Application.ActiveWorkbook
    Set sht = wb.Sheets("Arils Pack Plan ")
        LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row
        Set rngToAbs = sht.Range("F7:F" & LastRow)
    
    Set wb = Application.ActiveWorkbook
    Set sht1 = wb.Sheets("Arils Pack Plan ")
        LastRW5 = sht1.Cells(sht1.Rows.Count, "B").End(xlUp).Row
        Set Item = sht1.Range("B7:B" & LastRW5)
    
    Set wb = Application.ActiveWorkbook
    Set sht2 = wb.Sheets("Arils Pack Plan ")
        LastRW4 = sht2.Cells(sht2.Rows.Count, "E").End(xlUp).Row
        Set PalletType = sht2.Range("E7:E" & LastRW4)

you could do this:

    With ActiveWorkbook.Worksheets("Arils Pack Plan ")
        Set rngToAbs = .Range("F7:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
        Set Item = .Range("B7:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        Set PalletType = .Range("E7:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
    End With

Typically though, you don't want to be reading columns from the same table using different "last row" values - pick one column to find the last row, and use that for all the columns in the table.

Cameron Critchlow · Answer 2 · 2022-12-23T18:31:14.193

-1

I think this is what you're trying to accomplish with your for loop:

Option Explicit
Sub Example()

    Dim CL As Range
    Dim Onhand As Range
    Dim OutputArray
    Dim I As Long
    
    ' This section is just to define my own ranges for testing.
    ' You delete this and just make sure onhand is properly defined.
    Set Onhand = Sheet4.Range("B3:B25")
    
'   All the rest of your code...
    
    I = 1
    ReDim OutputArray(1 To Onhand.Cells.Count)
    For Each CL In Onhand.Cells
        If CL.Value < 0 Then
            OutputArray(I) = CL.Value
            I = I + 1
        End If
    Next CL
    
    'Change this to wherever you want the data pasted.
    Sheet4.Range("E3").Resize(I, 1) = Application.Transpose(OutputArray)

End Sub

This ? :

edited Dec 23 '22 at 18:31

answered Dec 16 '22 at 20:18

Cameron Critchlow

1,814
1
4
14

That's saying "for each range object in the collection of ranges in `Onhand`, do this." – Cameron Critchlow Dec 16 '22 at 20:19
That's exactly what I am trying to do. But, It won't let me run that code without a do loop. I keep getting an error message. – Jonathan Anguiano Dec 17 '22 at 16:01
Oh. What? I guess my brain just took a vacation... I ended the `For` loop with a `Loop` , not a `Next CL` ... No idea where that came from. I corrected the answer. – Cameron Critchlow Dec 19 '22 at 16:53
hahaha it's okay it was a Friday. Thank you! – Jonathan Anguiano Dec 19 '22 at 17:11
It is pasting the value in the entire range. I need it to paste the value within the first cell of the range then continue to paste each individual value in the next cell. Do you think that's possible? – Jonathan Anguiano Dec 23 '22 at 16:43
I'm not sure I understand. – Cameron Critchlow Dec 23 '22 at 16:49
So I need it to look in each cell in workbook2 cells to determine if it is negative. If it is negative copy that value and paste it in the first cell in the workbook1 range and repeat the process until the range expires and move onto the next range. – Jonathan Anguiano Dec 23 '22 at 17:08
And when it pastes the value in the first cell, I need it to move down the range of cells pasting the negative values from workbook2. – Jonathan Anguiano Dec 23 '22 at 17:10
Yeah I didn't really look at what was inside of the loop. Just corrected the loop. – Cameron Critchlow Dec 23 '22 at 18:22
Okay I changed the answer. – Cameron Critchlow Dec 23 '22 at 18:30
I am struggling to continue the macro to repeat the process on another range. I changed my code above – Jonathan Anguiano Jan 03 '23 at 16:00
Also, I want it to continue pasting right below the previous paste range. – Jonathan Anguiano Jan 03 '23 at 16:15

Paste Loop while value is negative

2 Answers2