LOOPING PROCEDURE IN ERROR IF THE ARGUMENT IS MET - PLS HELP

[blackorchids2002]

Hi Masters,

I can't figure out on how to complete the procedure. Below is the full code of what I am trying to do.
After the set of these code below when the condition is met in my 1st loop, THEN on the 2nd loop it will overwrite the data copied and inserted on the 2nd row. The 2nd loop should be placed on the 3rd row.

1st loop - 1st row data copied from mmraw sheet.
1st loop if the condition is met where there is a discount found in 1st row - it will copied & be placed on the 2nd row of the active sheet (sheet 2 mmcalc).

2nd loop - 2nd row data copied from mmraw sheet. This should be placed on the 3rd row of the active sheet. But this code is giving me now an error if the condition is met in the 1st loop. This will override the data in the 2nd row.


If Cells(4 + x, 22) <> 0 Then ' IF THE DISCOUNT COLUMN DOES NOT EQUAL TO ZERO THEN COPY THE ROW AND INSERT COPIED CELLS
Rows(4 + x).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Cells(5 + x, 10).Value = "PROMOS AND DISCOUNTS"
Cells(5 + x, 14).Value = Cells(5 + x, 22)
Cells(5 + x, 16).Value = Cells(5 + x, 14) * Cells(5 + x, 15)

End If




FULL CODE:
Dim Last_Row As Long
Dim mmraw As Worksheet, mmcalc As Worksheet
Dim x As Integer, y As Integer

Set mmraw = Sheets("Excel Report")
Set mmcalc = Sheets("WP-Excel Report")
mmraw.Activate
mmraw.Cells(1, 1).Select

With ActiveSheet
Last_Row = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To Last_Row
If mmraw.Cells(x - 1, 1).Value <> "" Then
mmcalc.Activate
With ActiveSheet
For y = 1 To 17 ' LOOP THROUGH COLUMNS TO COPY THE DATA FROM SHEET MMRAW
Cells(4 + x, 1).Value = x - 1 'ROW A6 IN WP-Excel Report
Cells(4 + x, y + 1).FormulaR1C1 = mmraw.Cells(x, y) 'ROW 2 & COL 1 IN Excel Report
Cells(4 + x, 20).Formula = "=" & "N" & 4 + x
Cells(4 + x, 21).Formula = "=" & "P" & 4 + x & "/" & "O" & 4 + x
Cells(4 + x, 22).Formula = "=" & "U" & 4 + x & "-" & "T" & 4 + x
Next
End With
ElseIf x = "" Then
Cells(5, 1).Select
End If

If Cells(4 + x, 22) <> 0 Then ' IF THE DISCOUNT COLUMN DOES NOT EQUAL TO ZERO THEN COPY THE ROW AND INSERT COPIED CELLS
Rows(4 + x).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Cells(5 + x, 10).Value = "DISCOUNTS"
Cells(5 + x, 14).Value = Cells(5 + x, 22)
Cells(5 + x, 16).Value = Cells(5 + x, 14) * Cells(5 + x, 15)

End If

Next
End With
End Sub

Many thanks in advance.

 

[blackorchids2002]

Pls help

 

[Trebor76]

Hi there,

Not sure what the code is trying to achieve but the main issue was the formula in Col. U of the WP-Excel Report tab was in error if there was nothing in columns P and O which causes code to error out on.

I have added the IFERROR function to return zero if this happens as well as changing this line "ElseIf x = "" Then" to simply "Else".

Option Explicit
Sub Macro1()

    Dim Last_Row As Long
    Dim mmraw As Worksheet, mmcalc As Worksheet
    Dim x As Long, y As Long
    
    Set mmraw = Sheets("Excel Report")
    Set mmcalc = Sheets("WP-Excel Report")
    mmraw.Activate
    mmraw.Cells(1, 1).Select
    
    With ActiveSheet
        
        Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
        
        For x = 2 To Last_Row
            If mmraw.Cells(x - 1, 1).Value <> "" Then
                mmcalc.Activate
                With ActiveSheet
                    For y = 1 To 17 ' LOOP THROUGH COLUMNS TO COPY THE DATA FROM SHEET MMRAW
                        Cells(4 + x, 1).Value = x - 1 'ROW A6 IN WP-Excel Report
                        Cells(4 + x, y + 1).FormulaR1C1 = mmraw.Cells(x, y) 'ROW 2 & COL 1 IN Excel Report
                        Cells(4 + x, 20).Formula = "=" & "N" & 4 + x
                        Cells(4 + x, 21).Formula = "=IFERROR(" & "P" & 4 + x & "/" & "O" & 4 + x & ",0)"
                        Cells(4 + x, 22).Formula = "=IFERROR(" & "U" & 4 + x & "-" & "T" & 4 + x & ",0)"
                    Next y
                End With
            Else
                Cells(5, 1).Select
            End If
            
            If Cells(4 + x, 22) <> 0 Then ' IF THE DISCOUNT COLUMN DOES NOT EQUAL TO ZERO THEN COPY THE ROW AND INSERT COPIED CELLS
                Rows(4 + x).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                Application.CutCopyMode = False
                Cells(5 + x, 10).Value = "DISCOUNTS"
                Cells(5 + x, 14).Value = Cells(5 + x, 22)
                Cells(5 + x, 16).Value = Cells(5 + x, 14) * Cells(5 + x, 15)
            End If
        
        Next x
        
    End With
    
End Sub

Hope that helps.

Robert