Paste Loop while value is negative-CodePudding

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 LastRow As Long
Dim LastRW As Long
Dim LastRW1 As Long
Dim LastRW2 As Long
Dim LastRW3 As Long
Dim LastRW4 As Long
Dim LastRW5 As Long
Dim LastRW6 As Long
Dim LastRW7 As Long
Dim LastRW8 As Long
Dim LastRW9 As Long
Dim LastRW10 As Long
Dim c As Range
Dim wb As Workbook
Dim nwb As Workbook
Dim i As Range
Dim OnHand As Range
Dim OnHand2 As Range
Dim OnHand1 As Range
Dim Pallet As Range
Dim PalletType As Range
Dim Item As Range
Dim Item2 As Range
Dim UnitQty As Range

'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)

'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)")
    LastRW = nwbsht1.Cells(nwbsht1.Rows.Count, "Q").End(xlUp).Row
    Set OnHand = nwbsht1.Range("Q5:Q14" & LastRW)

Set nwb = Application.ActiveWorkbook
Set nwbsht2 = nwb.Sheets("DAILY NEED (DR)")
    LastRW6 = nwbsht2.Cells(nwbsht2.Rows.Count, "E").End(xlUp).Row
    Set Pallet = nwbsht2.Range("E5:E14" & LastRW6)

Set nwb = Application.ActiveWorkbook
Set nwbsht3 = nwb.Sheets("DAILY NEED (DR)")
    LastRW1 = nwbsht3.Cells(nwbsht3.Rows.Count, "T").End(xlUp).Row
    Set OnHand1 = nwbsht3.Range("T5:T14" & LastRW1)

Set nwb = Application.ActiveWorkbook
Set nwbsht4 = nwb.Sheets("DAILY NEED (DR)")
    LastRW2 = nwbsht4.Cells(nwbsht4.Rows.Count, "Y").End(xlUp).Row
    Set OnHand2 = nwbsht4.Range("Y5:Y14" & LastRW2)


'8oz Range Setting
Set nwb = Application.ActiveWorkbook
Set nwbsht5 = nwb.Sheets("DAILY NEED (DR)")
    LastRW7 = nwbsht5.Cells(nwbsht5.Rows.Count, "Q").End(xlUp).Row
    Set OnHand = nwbsht5.Range("Q15:Q25" & LastRW7)

Set nwb = Application.ActiveWorkbook
Set nwbsht6 = nwb.Sheets("DAILY NEED (DR)")
    LastRW8 = nwbsht6.Cells(nwbsht6.Rows.Count, "E").End(xlUp).Row
    Set Pallet = nwbsht6.Range("E15:E25" & LastRW8)

Set nwb = Application.ActiveWorkbook
Set nwbsht7 = nwb.Sheets("DAILY NEED (DR)")
    LastRW9 = nwbsht7.Cells(nwbsht7.Rows.Count, "T").End(xlUp).Row
    Set OnHand1 = nwbsht7.Range("T15:T25" & LastRW9)

Set nwb = Application.ActiveWorkbook
Set nwbsht8 = nwb.Sheets("DAILY NEED (DR)")
    LastRW10 = nwbsht8.Cells(nwbsht8.Rows.Count, "Y").End(xlUp).Row
    Set OnHand2 = nwbsht8.Range("Y15:Y25" & LastRW10)

'Copy and Paste Loop
nwb.Activate

Do While i < OnHand
For i = 1 to
If OnHand.Value < 0 Then
    nwb.Activate
    OnHand.Select
    wb.Activate
    Selection.Copy
    rngToAbs.PasteSpecial Paste:=xlPasteValues
End If
Next i


' Absolute_Value Macro
For Each c In rngToAbs
    c.Value = Abs(c.Value)
    If rngToAbs.Cells(c, 1).Value <> "" Then Exit For
Next c
End Sub

CodePudding user response：

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

Sub Example()

    Dim CL As Range
    Dim Onhand As Range
    
'   All the rest of your code...

    For Each CL In Onhand.Cells
        If CL.Value < 0 Then
            nwb.Activate
            CL.Select
            wb.Activate
            Selection.Copy
            rngToAbs.PasteSpecial Paste:=xlPasteValues
        End If
    Loop
    
End Sub

CodePudding user response：

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 ThisWorkbook.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.