CODEWITHSUNDEEP
vbaexcelerror-handling
Alfa Bachtiar
Alfa Bachtiar

Reputation: 73

separating error cells to another worksheet with VBA

lately i try to separating error cells to another worksheet, and resume the program. runtime error '1004' usually happens in shtOut.Cells(2, 1).Resize(r2, 3).Value = arrOut, this error caused by the value in column 3 that way too long.

     Sub Merge_desc()

        Dim shtIn As 

Worksheet, shtOut As Worksheet, errout As Worksheet

    Dim arrIn
    Dim arrOut
    Dim ub As Long, r As Long, r2 As Long
    Dim num
    Dim order
    Dim desc
    Dim syalala


        Set shtIn = ThisWorkbook.Sheets("Control Deck")
        Set shtOut = ThisWorkbook.Sheets("Process")
        Set errout = ThisWorkbook.Sheets("error")

        'load the input data to an array
        arrIn = shtIn.Range(shtIn.Range("A1"), shtIn.Cells(Rows.Count, 3).End(xlUp)).Value

        ub = UBound(arrIn, 1)
        'resize the output array to match
        ReDim arrOut(1 To ub, 1 To 3)
        r2 = 1

        For r = 1 To ub
            ' start of a new item
            If Len(arrIn(r, 1)) > 0 Then
                'output any previous item to the second array
                If Len(num) > 0 Then
                    arrOut(r2, 1) = num
                    arrOut(r2, 2) = order
                    arrOut(r2, 3) = desc
                    r2 = r2 + 1
                End If
                'store the current item info
                num = arrIn(r, 1)
                order = arrIn(r, 2)
                desc = arrIn(r, 3)
            Else
                'still on the same item, so add to the description
                                    desc = desc & arrIn(r, 3)
            End If

        Next r

        'add the last item...
        If Len(num) > 0 Then
            arrOut(r2, 1) = num
            arrOut(r2, 2) = order
            arrOut(r2, 3) = desc
        End If

        'add header
        shtOut.Cells(1, 1).Resize(1, 3).Value = _
          Array("Material Number", "Short Description", "Long Description")
    y = 1
        'dump the output array to the worksheet
        shtOut.Cells(2, 1).Resize(r2, 3).Value = arrOut
        If IsError(arrOut) Then
            Do While errout.Cells(y, 1).Value = ""
           shtOut.Cells(2, 1).Resize(r2, 3).Cut
           errout.Cells(y, 1).Paste
           y = y + 1
           Loop
        End If





    End Sub

i add 

   If IsError(arrOut) Then
                Do While errout.Cells(y, 1).Value = ""
               shtOut.Cells(2, 1).Resize(r2, 3).Cut
               errout.Cells(y, 1).Paste
               y = y + 1
               Loop
            End If

and hoping that works, but it's not. haha. i'm pretty sure i've done wrong. how to make it right?

update i've tried as l42 suggested.

    On Error Resume Next 'this line does what it say's
shtOut.Cells(2, 1).Resize(r2, 3).Value = arrOut 'this line is what you suspect to have error
On Error GoTo 0 'this is the "Next" line after the error which resets the error and allows you to handle it
If IsEmpty(shtOut.Cells(2, 1).Resize(r2, 3)) Then 'assuming this range is empty to start with
shtOut.Cells(2, 1).Resize(r2, 3).Value.Cut
    Do While errout.Cells(y, 3).Value = ""
    errout.Cells(y, 1).Paste
    y = y + 1
    Loop '~~> you put your error handling here
End If

but nothing happen. :|

Upvotes: 2

Views: 84

Answers (1)

L42
L42

Reputation: 19727

Here's a simple demo of resume next:

On Error Resume Next 'this line does what it say's
shtOut.Cells(2,1).Resize(r2,3).Value = arrOut 'this line is what you suspect to have error
On Error Goto 0 'this is the "Next" line after the error which resets the error and allows you handle it.

With Application.WorksheetFunction
    If .CountA(shtOut.Cells(2,1).Resize(r2,3)) = 0 Then
    '~~> your code here
    End If
End With

Again, i assumed your target range is empty before you execute the code and will only populate if you successfully pass arrOut.

Upvotes: 1

Related Questions