Q:

Rearrange a set of pictures VBA

I'm trying to organise a set of data on an excel worksheet.
I'm very new to vba so apologies if I am not explaining my ultimate goal very well...I am feeling around blindly in the dark with this!
Basically I am trying to do the following:
A user will enter some data in different cells and a picture related to the data. There is a cell in which they enter the order in which they would like the data to appear(See Fault number in the A column in figure below (a screenshot of the worksheet)). 

So for example - they will enter the information for 2 different 'faults' and they are in the order 2, 1. (This is an over simplified example - there will be up to 80 'faults') On the click of the "Organise Faults" button, the data will be rearranged.
I have no problem rearranging the text and this is working perfectly. What I am having an issue with is grabbing the picture related to the data. I have tried lots of different ways of doing this and am at a complete loss.
Below is my code for rearranging - what I have done is create a 'fault' object. On click of the 'Organise Faults' button this creates an array of faults, rearranges them in order according to the fault number and then pastes them in the correct location. The 'Move larger image' / 'Move smaller image' subsare called within this sub.
I know my code is long winded but I am putting it in for clarity. The relevant section is at the end - either the 'MoveLargerImage' / 'MoveSmallerImage' sub. Once I get one working I am pretty sure I can get the second one working - as it does the same thing.
Any pointers in the right direction are much appreciated.
Thanking you!
Public Sub ReArrangeFaults()

'Set up a counter to hold the array length
Dim arrayLength As Integer
arrayLength = 0

'Set counter to indicate cells
Dim i As Integer
i = 6

'Set a counter
Dim counter As Integer
counter = 0

'*******************Loop through to count faults********************************
While Len(Worksheets("Analysis").Cells(i, 1)) <> 0
arrayLength = arrayLength + 1
i = i + 30
'MsgBox "Count at: " & arrayLength
Wend
'*******************Loop end********************************

'Reset i
i = 6

'*****Set up an array in which faults will be held and loop through to populate it*****
Dim faultArray() As cFault
ReDim faultArray(0 To arrayLength) As cFault
Dim oShape As Shape
Dim shapeName As String

While counter < arrayLength

    'Create a fault class and assign all variables
    Dim f As cFault
        f.faultNumber = Worksheets("Analysis").Cells(i, 1)
        f.Priority = Worksheets("Analysis").Cells(i, 3)
        f.Location = Worksheets("Analysis").Cells(i + 1, 3)
        f.EquipmentID = Worksheets("Analysis").Cells(i + 2, 3)
        f.Component = Worksheets("Analysis").Cells(i + 3, 3)
        f.FigureNumber = Worksheets("Analysis").Cells(i + 4, 3)
        f.AnalysisParagraph = Worksheets("Analysis").Cells(i + 11, 2)
        f.ActionRequired = Worksheets("Analysis").Cells(i + 21, 2)
        f.StartPosition = Worksheets("Analysis").Cells(i, 1)

    faultArray(counter) = f
    'MsgBox "Count at: " & counter
    i = i + 30 'To set where to find data
    counter = counter + 1 'To increment loop
    Wend
'*******************End array creation********************************

'*******************Sort array according to fault number**************
Dim SrtTemp As cFault
Dim m As Long
Dim n As Long

    For m = 0 To arrayLength - 1
         For n = m + 1 To arrayLength - 1
             If faultArray(m).faultNumber > faultArray(n).faultNumber Then
                 SrtTemp = faultArray(n)
                 faultArray(n) = faultArray(m)
                 faultArray(m) = SrtTemp
             End If
         Next n
     Next m
'*******************End of sorting algorithm*************************

'*******************Loop through array and paste objects**************
counter = 0
i = 6
While counter < arrayLength

        Worksheets("Analysis").Cells(i, 1) = faultArray(counter).faultNumber
        Worksheets("Analysis").Cells(i, 3) = faultArray(counter).Priority
        Worksheets("Analysis").Cells(i + 1, 3) = faultArray(counter).Location
        Worksheets("Analysis").Cells(i + 2, 3) = faultArray(counter).EquipmentID
        Worksheets("Analysis").Cells(i + 3, 3) = faultArray(counter).Component
        Worksheets("Analysis").Cells(i + 4, 3) = faultArray(counter).FigureNumber
        'Worksheets("Overview").Range("G10").Formula = "=COUNTIF('List of     Leakages'!A2:A500,""<>"")"
        Worksheets("Analysis").Cells(i + 4, 3).Formula = "=A" & CStr(i)
        Worksheets("Analysis").Cells(i + 11, 2) = faultArray(counter).AnalysisParagraph
        Worksheets("Analysis").Cells(i + 21, 2) = faultArray(counter).ActionRequired
        MoveLargeImage faultArray(counter).StartPosition,     faultArray(counter).faultNumber
        MoveSmallImage faultArray(counter).StartPosition,     faultArray(counter).faultNumber

counter = counter + 1
i = i + 30
Wend

'*******************End Arranging objects*****************************

    MsgBox "Organised!"
End Sub

Here is the 'MoveLargerImage' Sub:
Sub MoveLargeImage(i As Integer, j As Integer)

    Dim r As Range
    Set r = Range("J" & CStr(i) & ":J" & CStr(i + 29))
    Dim oShape As Shape
    Dim shapeName As String
    shapeName = "nothing"
    Dim p As Integer
    If j > 1 Then
    p = ((j - 1) * 30) + 8
    End If
    If j = 1 Then
    p = 8
    End If
    Dim count As Integer
    count = 0

    For Each oShape In ActiveSheet.Shapes
    If (oShape.Type = msoPicture) Then
            If Not Intersect(ActiveSheet.Range("J" & CStr(i) & ":J" & CStr(i + 29)),  _
                                           oShape.TopLeftCell) Is Nothing Then
                oShape.Name = "LargeImage" & i
                shapeName = oShape.Name
            End If
    End If
    Next oShape
    If Not shapeName = "nothing" Then
        Sheets("Analysis").Shapes(shapeName).Cut
        Sheets("Analysis").Paste Sheets("Analysis").Range("J" & CStr(p) & ":J" & CStr(p + 19))
    End If
End Sub

And here is the 'MoveSmallerImage' sub (pretty much the same desired outcome - just different positioning)
Sub MoveSmallImage(i As Integer, j As Integer)

    Dim r As Range
    Set r = Range("E" & CStr(i) & ":E" & CStr(i + 29))
    Dim oShape As Shape
    Dim shapeName As String
    shapeName = "nothing"
    Dim p As Integer
    If j > 1 Then
    p = ((j - 1) * 30) + 6
    End If
    If j = 1 Then
    p = 6
    End If
    Dim count As Integer
    count = 0

    For Each oShape In ActiveSheet.Shapes
    If Not Intersect(ActiveSheet.Range("E" & CStr(i) & ":E" & CStr(i + 10)), _
                                          oShape.TopLeftCell) Is Nothing Then
            oShape.Name = "SmallImage" & i
            shapeName = oShape.Name
            End If
            Next oShape
            If Not shapeName = "nothing" Then
    Sheets("Analysis").Shapes(shapeName).Cut
    Sheets("Analysis").Paste Sheets("Analysis").Range("E" & CStr(p) & ":E" & CStr(p + 7))
    End If
End Sub

Thank you!!

A:

I think the best way is to capture the image names at the same time you fill your fault class. Since each image name is unique, you'll know which images go with which fault. Looping through the shapes is the only way to associate a shape with a range, so you got that part right.  Add two properties to your class: SmallImageName and LargeImageName. Then checkout this rewrite.
First, the main procedure
Public Sub ReArranageFaults2()

    Dim colFaults As Collection
    Dim i As Long
    Dim lLastRow As Long
    Dim sh As Worksheet
    Dim clsFault As CFault
    Dim rStart As Range

    Set sh = ThisWorkbook.Worksheets("Analysis")
    lLastRow = sh.Cells(sh.Rows.count, 1).End(xlUp).Row
    Set colFaults = New Collection

    'Loop through the worksheet skipping every 30 rows
    'and fill an instance of CFault
    'then add that object to the collection
    For i = 5 To lLastRow Step 30
        Set clsFault = New CFault
        clsFault.FillFromRange sh.Cells(i, 1).Resize(30, 10)
        colFaults.Add clsFault
    Next i

    'sort the collection by fault number
    SortCollection colFaults

    'Now loop through the collection and write
    'the faults back to the worksheet
    Set rStart = sh.Cells(5, 1)
    For i = 1 To colFaults.count
        Set clsFault = colFaults(i)
        With rStart.Offset((i - 1) * 30, 0)
            .Offset(1, 0).Value = clsFault.FaultNumber
            .Offset(1, 2).Value = clsFault.Priority
            .Offset(2, 2).Value = clsFault.Location
            .Offset(3, 2).Value = clsFault.EquipmentID
            .Offset(4, 2).Value = clsFault.Component
            .Offset(5, 2).Value = clsFault.FigureNumber
            .Offset(12, 1).Value = clsFault.AnalysisParagraph
            .Offset(22, 1).Value = clsFault.ActionRequired
            sh.Shapes(clsFault.SmallImageName).Left = .Offset(1, 4).Left
            sh.Shapes(clsFault.SmallImageName).Top = .Offset(1, 4).Top
            sh.Shapes(clsFault.LargeImageName).Left = .Offset(3, 9).Left
            sh.Shapes(clsFault.LargeImageName).Top = .Offset(3, 9).Top
        End With
    Next i

End Sub

I moved the filling of the object to inside class just to keep things tidy
Public Sub FillFromRange(rRng As Range)

    Dim shp As Shape

    'Fill the properties
    Me.FaultNumber = rRng.Cells(2, 1).Value
    Me.Priority = rRng.Cells(2, 3).Value
    Me.Location = rRng.Cells(3, 3).Value
    Me.EquipmentID = rRng.Cells(4, 3).Value
    Me.Component = rRng.Cells(5, 3).Value
    Me.FigureNumber = rRng.Cells(6, 3).Value
    Me.AnalysisParagraph = rRng.Cells(13, 2).Value
    Me.ActionRequired = rRng.Cells(23, 2).Value

    'Loop through all the shapes on the sheet
    For Each shp In rRng.Parent.Shapes
        'If it's within the range, it's either the large or the small
        If Not Intersect(shp.TopLeftCell, rRng) Is Nothing Then

            'If I haven't assigned a small yet, assume the first image
            'is the small image
            If Len(Me.SmallImageName) = 0 Then
                Me.SmallImageName = shp.Name
            Else 'I've already processed one image and assume it was the small

                'If the already processed image is bigger than the current image
                'then move small to large and save the current as small
                If rRng.Parent.Shapes(Me.SmallImageName).Width > shp.Width Then
                    Me.LargeImageName = Me.SmallImageName
                    Me.SmallImageName = shp.Name
                Else 'If the alread processed image is smaller than the current
                    'image, then it's in the right place, and we have only to
                    'store the large
                    Me.LargeImageName = shp.Name
                End If
            End If
        End If
    Next shp

End Sub

And finally, the procedure to sort the collection. I prefer a collection over an array unless I'm doing something in particular that requires an array. With a collection, you just add to it as needed as opposed to having to figure out the dimensions beforehand.
Public Sub SortCollection(ByRef col As Collection)

    Dim i As Long
    Dim j As Long
    Dim obj As Object

    For i = 1 To col.count - 1
        For j = i To col.count
            If col.Item(i).FaultNumber > col.Item(j).FaultNumber Then
                Set obj = col.Item(i)
                col.Remove i
                col.Add obj, , , j - 1
            End If
        Next j
    Next i

End Sub

