Question

Hello, I am doing a macro that copy the values on the columns, VALUES1, VALUES2, VALUES3 if it is not blank when the ARTICLE is the same.

I would have the first spreadsheet and I want the macro to return the second Spreadsheet.

I have managed how to make it:

Sub test()

Dim i, last, j, x As Integer
Dim R As Range

last = Sheets("List2").Range("A100000").End(xlUp).Row - 2

For i = 0 To last

    Set R = Sheets("List2").Range("A2")

        If Not WorksheetFunction.CountIf(Sheets("List2").Columns(1), _
        Sheets("List2").Range("A2").Offset(i, 0).Value) = 0 Then

            For j = 1 To WorksheetFunction.CountIf(Sheets("List2").Columns(1), _

                Sheets("List2").Range("A2").Offset(i, 0).Value)
                Set R = Sheets("List2").Columns(1).Find(Sheets("List2").Range("A2"). _
                Offset(i, 0).Value, R, LookAt:=xlWhole)

                    For x = 0 To 2

                        If Not Sheets("List2").Range("B2").Offset(i, x).Value = "" Then

                            R.Offset(0, "1" + x).Value = Sheets("List2"). _ 
                            Range("B2").Offset(i, x).Value

                        End If
                    Next x
            Next j
        End If
Next i

End Sub

but the problem it takes too long, ’cause I have around 10.000 Rows and 20 Columns, and besides the Spreadsheet is not in order, so it could be to has a disorder, something like (A, B, B, A, …)

Is there any way to make it faster o better???

Thanks a lot. Themolestones.

Answer 1

Here is a very easy solution with formulas to your problem:

Sheet2!A1=Sheet1!A1
Sheet2!B1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!B:B)

Sheet2!C1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!C:C)
Sheet2!D1=SUMIF(Sheet1!$A:$A,Sheet2!$A1,Sheet1!D:D)

Put these formulas in the cells left of the = and copy down. You really need only the first two, because you can copy the second also to the right.

You need Sheet1 to be sorted by article.

That’s it.

Of course, there might be occasions, when it is just necessary to implement this with VBA. Usually the fastest way to handle large amounts of cells with VBA, is to use array-copies of your ranges. Using worksheet-functions and looping through single cell references slows you down heavily.

Edit:

This would be my VBA solution

Public Sub Demo()
  Dim arrRange() As Variant
  Dim arrRangeResult() As Variant
  Dim i As Long
  Dim j As Long
  Dim copyVal As Variant
  Dim copyCond As Variant
  Dim copyCol As Long

  'create two copies of the origin data
  arrRange = Range("A:D")
  arrRangeResult = Range("A:D")

  'loop through first data-copy, downwards through the articles
  For i = LBound(arrRange, 1) + 1 To UBound(arrRange, 1)
    'stop loop, if no article was found
    If arrRange(i, 1) = "" Then Exit For
    'store current article ID
    copyCond = arrRange(i, 1)
    'loop sideways through value-columns
    For j = LBound(arrRange, 2) + 1 To UBound(arrRange, 2)
      'store value & column, when found
      If arrRange(i, j) <> "" Then
        copyVal = arrRange(i, j)
        copyCol = j
        Exit For
      End If
    Next j

    'loop through output array and paste value
    For j = LBound(arrRangeResult, 1) + 1 To UBound(arrRangeResult, 1)
      If arrRangeResult(j, 1) = copyCond Then
        'paste-down found value to all occurences of article
        arrRangeResult(j, copyCol) = copyVal
      ElseIf arrRangeResult(j, 1) = "" Then
        'early stop, when no article ID is found
        Exit For
      End If
    Next j
  Next i

  'create output
  Range("K:N") = arrRangeResult
End Sub