CODEWITHSUNDEEP
vbaexcel
jrb2b
jrb2b

Reputation: 55

VBA Type mismatch error on Do While ActiveCell.Value <> ""

Hey I've got code moving rows out to another sheet with the name of the cell, a loop until it hits a blank at the end of the data, an extract of the code here;

Range("AF2").Select
Do While ActiveCell.Value <> ""
    strDestinationSheet = ActiveCell.Value
    ActiveCell.Offset(0, -31).Resize(1, ActiveCell.CurrentRegion.Columns.count).Select
    Selection.Copy

    Sheets(strDestinationSheet).Select
    N = Cells(Rows.count, "AF").End(xlUp).Row
    lastRow = N

    Cells(lastRow + 1, 1).Select
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    Sheets(strSourceSheet).Select
    ActiveCell.Offset(0, 31).Select
    ActiveCell.Offset(1, 0).Select
Loop

However while this part of the code worked fine before on the latest instance of running it now throws up an error on the second line Do While ActiveCell.Value <> "", saying type mismatch. I'm unsure of what's changed to stop this working suddenly, any ideas? Many thanks.

Upvotes: 1

Views: 1745

Answers (1)

Scott Craner
Scott Craner

Reputation: 152585

I personally do not like Do Loops to iterate through a group of cells. I prefer the For Each loop.

Also as was stated by @bruceWayne, avoid using Select as is slows down the code.

Proper indentation makes the code easier to read and avoid simple mistakes.

Dim cel As Range
With Sheets(strSourceSheet)
    For Each cel In .Range("AF2", .Range("AF2").End(xlDown))
        If Not IsError(cel) Then
            strDestinationSheet = cel.Value
            cel.Offset(0, -31).Resize(1, cel.CurrentRegion.Columns.Count).Copy
            N = Sheets(strDestinationSheet).Cells(Sheets(strDestinationSheet).Rows.Count, "AF").End(xlUp).Row
            Sheets(strDestinationSheet).Cells(N + 1, 1).PasteSpecial xlPasteValues
        End If
    Next cel
End With

Upvotes: 4

Related Questions