The code erase the cells contents before run

[Villalobos]

Hi,

I use this code to summarize and paste the data but I have some problem. The code is working fine, but erase (before the running) the cell contents (sheet Calculation) which are under row #3.

 Private Sub CommandButton1_Click()
Dim x, y(), i&, j&, k&
        fltrCrit = Sheets(2).Range("C1")
        x = Sheets(1).Range("C7").CurrentRegion.Value
        ReDim y(1 To UBound(x), 1 To 2): j = 1
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
                For i = 2 To UBound(x)
                    If x(i, 3) > 0 Then
                        If x(i, 2) <= fltrCrit Then
                            If .Exists(x(i, 1)) Then
                                k = .Item(x(i, 1)): y(k, 2) = y(k, 2) + x(i, 3)
                            Else
                                j = j + 1: .Item(x(i, 1)) = j
                                y(j, 1) = x(i, 1): y(j, 2) = x(i, 3)
                            End If
                        End If
                    End If
                Next i
        End With
        y(1, 1) = "Product number": y(1, 2) = "Required quantity"
        With Sheets(2).Range("B4").CurrentRegion
            .ClearContents
            .Resize(j, 2).Value = y()
        End With
End Sub

How should I modify this code to avoid this problem?
The sample file has been attached.

Thanks in advance the response!

 

[NARAYANK991]

Hi ,

Change the following line of code :

With Sheets(2).Range("B4").CurrentRegion

to :

With Sheets(2).Range("B4").CurrentRegion.Resize(, 2)

Narayan

 

[Villalobos]

Good evening Narayan,

Great help, thank you!