I am currently working on a script that will copy some data from one sheet to another, but I keep getting the following error message:
Run time error: Object required
at
Set uRng = .Range("F1", .Range("F" & .Rows.Count).End(xlUp))
What could be causing it?
Code below:
Sub Collapse()
Dim uRng As Range, cel As Range
Dim comps As Variant, comp As Variant, r As Variant, v As Variant
'Dim d As Dictionary '~~> Early bind, for Late bind use commented line
Dim d As Object
Dim a As String
With Emails '~~> Sheet that contains your data
Set uRng = .Range("F1", .Range("F" & .Rows.Count).End(xlUp))
End With
Set d = CreateObject("Scripting.Dictionary")
With d
For Each cel In uRng
a = Replace(cel.Offset(0, -3), "{", "}")
comps = Split(a, "}")
Debug.Print UBound(comps)
For Each comp In comps
If InStr(comp, "Computer") <> 0 _
And Len(Trim(comp)) <= 10 Then '~~> I assumed max Comp# is 99
If Not .Exists(cel) Then
.Add cel, comp
Else
If IsArray(.Item(cel)) Then
r = .Item(cel)
ReDim Preserve r(UBound(r) + 1)
r(UBound(r)) = comp
.Item(cel) = r
Else
r = Array(.Item(cel), comp)
.Item(cel) = r
End If
End If
End If
Next
Next
End With
For Each v In d.Keys
With Sheet2 '~~> sheet you want to write your data to
If IsArray(d.Item(v)) Then
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) _
.Resize(UBound(d.Item(v)) + 1) = v
.Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) _
.Resize(UBound(d.Item(v)) + 1) = Application.Transpose(d.Item(v))
Else
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = v
.Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = d.Item(v)
End If
End With
Next
Set d = Nothing
End Sub
Bookmarks