'1004': Application-defined or object defined error (VBA)

[jBenzer]

Hi,

I am pretty new to VBA and I have been trying to execute the following code however, it is giving me an error "Application-defined or object-defined error". I am unable to figure out where am I going wrong.

Can someone please review my code and help me fix it? Thank you very much in advance

Sub SelectBetween()

Dim sourceRange As Range
Dim transposeRange As Range
Dim rowCount As Integer
Dim rangeCount As Long

'Initialize rowCount'
rowCount = 0

Worksheets("sheet1").Activate

'Determine max number for loop'
Set sourceRange = Range(Range("A:A").Find("abc"), Range("A:A").Find("xyz"))
rangeCount = sourceRange.Rows.Count
Debug.Print rangeCount

For i = 1 To rangeCount

Set sourceRange = Range(Range("A:A").Find("FROM"), Range("A:A").Find("RXNBR"))
'sourceRange.Select'

'Copy range to transpose'
sourceRange.Copy

'Transpose the selected range'
Set transposeRange = ActiveSheet.Cells(rowCount + 1, "B")
transposeRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

sourceRange.Delete

rowCount = rowCount + 1


Next i

'Delete empty column A'
Columns(1).EntireColumn.Delete

End Sub

[Artik]

Indicate in which line of code you get an error.
And it's best if you put a representative attachment, because I can see that you are doing strange things with this macro.

Artik

[jBenzer]

Hi Artik,

Please find attached representation of what I am trying to achieve. I am trying to select a range of cells starting with "abc" and ending with "xyz" and then transposing it to Column B (Starting with B1, B2 and so on). Sorry for the confusion.

Capture.jpg

[Artik]

For the future, macros can not be tested on the image.

eg:

Sub AAA()
    Dim rowCount    As Long
    Dim sourceRange As Range


    On Error GoTo HandleError


    Application.ScreenUpdating = False


    With Worksheets("sheet1")
        .Activate


        Do
            Set sourceRange = Nothing


            'A runtime error is created when the range can not be defined ("abc" or/and "xyz" was not found)
            Set sourceRange = .Range(.Range("A:A").Find("abc"), .Range("A:A").Find("xyz"))


            If Not sourceRange Is Nothing Then
                sourceRange.Copy
                .Cells(rowCount + 1, "B").PasteSpecial Paste:=xlPasteValues, _
                                                       Operation:=xlNone, _
                                                       SkipBlanks:=False, _
                                                       Transpose:=True
                sourceRange.Clear
                rowCount = rowCount + 1
            End If


        Loop Until sourceRange Is Nothing


HandleExit:
        .Range("A1").Select
    End With


    Exit Sub


HandleError:
    If sourceRange Is Nothing Then
        Resume HandleExit
    Else
        MsgBox Err.Number & vbLf & Err.Description, vbExclamation
    End If
End Sub

Artik