Run Time Error in coding - Can someone help me debug please?

I have attached an example file with a macro that strips data found in one column from matching data in another column.

I get a run time error on the line:
arrVariant = rngVariant.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value

Could someone help me fix the script please?

Option Compare Text

Public Sub StripVariants()

    Call StripVariant(Worksheets("Sheet1").Range("D:D"), Worksheets("Sheet1").Range("G:G"))
    Call StripVariant(Worksheets("Sheet1").Range("E:E"), Worksheets("Sheet1").Range("G:G"))

End Sub

Public Sub StripVariant(ByVal rngVariant As Excel.Range, ByVal rngText As Excel.Range)

    Dim arrVariant          As Variant
    Dim arrText             As Variant

    Dim lngLastRow          As Long
    Dim lngRow              As Long
    Dim intCol              As Integer
    Dim intPos              As Integer

    intCol = rngVariant.Column
    lngLastRow = rngVariant.Parent.Columns(intCol).Find(What:="*", After:=Cells(1, intCol), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Row
    arrVariant = rngVariant.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value
    arrText = rngText.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value

    For lngRow = LBound(arrVariant) To UBound(arrVariant)
        If Len(Trim(arrVariant(lngRow, 1))) > 0 Then
            intPos = InStr(1, arrText(lngRow, 1), Trim(arrVariant(lngRow, 1)))
            If intPos > 0 Then
                arrText(lngRow, 1) = Left(arrText(lngRow, 1), intPos - 1) _
                    & Mid(arrText(lngRow, 1), intPos + Len(arrVariant(lngRow, 1)))
                If Mid(arrText(lngRow, 1), intPos - 1, 2) = "  " Then
                    arrText(lngRow, 1) = Left(arrText(lngRow, 1), intPos - 1) _
                        & Mid(arrText(lngRow, 1), intPos + 1)
                ElseIf Mid(arrText(lngRow, 1), intPos - 1, 3) = " , " Then
                    arrText(lngRow, 1) = Left(arrText(lngRow, 1), intPos - 2) _
                        & Mid(arrText(lngRow, 1), intPos + 1)
                End If
            End If
        End If
    Next lngRow

    rngText.Cells(2, 1).Resize(UBound(arrText), 1).Value = arrText

End Sub

I'm pretty sure its the blanks in column E causing it. Sometimes, like column D, column E will have data and sometimes not. Any ideas?

The variable lngLastRow contains a value of 1, so you're trying to resize the range to have zero rows.

I'm not quite sure what you're trying to do, so I can't really tell you how to fix it, but if want to give me some more detail I'll have a go.

So there are two columns that contain variant information, size and colour, columns D and E. The product model name, column G, also sometimes contains this data but I need to strip these words out where it does find a match in the variant columns. If you open the example attached you will see what I mean. It works if I populate row 2 & 3 in column E with some text.

Thanks very much!

OK, I think I understand.

This is how I'd tackle that:

Sub StripVariant2(rngCheck As Range, rngMaster As Range)

Dim rngLoop As Range
Dim lOffset As Long

lOffset = rngCheck.Columns(1).Column - rngMaster.Columns(1).Column

For Each rngLoop In Range(rngMaster.Cells(1), Cells(Rows.Count, rngMaster.Columns(1).Column).End(xlUp)).Cells
  If rngLoop.Value <> "" And rngLoop.Offset(0, lOffset).Value <> "" Then
    rngLoop.Value = Replace(rngLoop.Value, rngLoop.Offset(0, lOffset).Value, "")
  End If
Next rngLoop

End Sub

Does that help you out?

That almost works a treat.

Where there is no size or colour it removes the spaces from the product model name. Any way to modify it for that?

Try changing this line:

If rngLoop.Value <> "" And rngLoop.Offset(0, lOffset).Value <> "" Then

To:

If rngLoop.Value <> "" And Trim(rngLoop.Offset(0, lOffset).Value) <> "" Then

That works great. Thank you very much!