Looping with variable data set - excel

Question

Based on the picture I would like for each animal to be copied to each Set/# (and for the outcome to be on Sheet 2).
Example of Goal
The issue is that it won't always be a set of 14 it can vary based on the data but the Animals would stay the same (no more then 4).
Below is what I have, granted it is not based on the picture. That is an example.
Sub DowithIf()
rw = 5
cl = 2
rw = 1000
Do While rw < erw
If Cells(rw, cl) <> Cells(rw - 1, cl) Then
Cells(rw, cl + 1) = Cells(rw, cl)
Range("A5:B5").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Range("A2:B4").Select
Application.CutCopyMode = False
Selection.FillDown
Sheets("Data").Select
Range("E3:J5").Select
Selection.Copy
Sheets("Sheet2").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Cells(rw, cl) = "" Then
Exit Do
End If
rw = rw + 1
Loop
End Sub

Answer 1

I think you'd find this easier if you looked at VBA as more of a programming language than a macro recorder. In your example, the task is really just to create an array whose row count is:
number of set names * number of set items
All you'd need to do is populate that array following a certain pattern. In your example it would be:
set number n with all set items, set number n + 1 with all set items, etc.
Skeleton code would look something like this:
Const SET_NAMES_ROW_START As Long = 6
Const SET_ITEMS_ROW_START As Long = 6
Const SET_NAMES_COL As String = "A"
Const SET_ITEMS_COL As String = "E"
Const OUTPUT_ROW_START As Long = 6
Const OUTPUT_COL As String = "G"
Dim names() As Variant, items() As Variant, output() As Variant
Dim namesCount As Long, itemsCount As Long
Dim idx As Long, nameIdx As Long, itemIdx As Long
'Read the set values.
With Sheet1
names = .Range( _
.Cells(SET_NAMES_ROW_START, SET_NAMES_COL), _
.Cells(.Rows.Count, SET_NAMES_COL).End(xlUp)) _
.Resize(, 2).Value2
items = .Range( _
.Cells(SET_ITEMS_ROW_START, SET_ITEMS_COL), _
.Cells(.Rows.Count, SET_ITEMS_COL).End(xlUp)) _
.Value2
End With
'Dimension the output array.
namesCount = UBound(names, 1)
itemsCount = UBound(items, 1)
ReDim output(1 To namesCount * itemsCount, 1 To 3)
'Populate the output array.
nameIdx = 1
itemIdx = 1
For idx = 1 To namesCount * itemsCount
output(idx, 1) = names(nameIdx, 1)
output(idx, 2) = names(nameIdx, 2)
output(idx, 3) = items(itemIdx, 1)
itemIdx = itemIdx + 1
If itemIdx > itemsCount Then
'Increment the name index by 1.
nameIdx = nameIdx + 1
'Reset the item index to 1.
itemIdx = 1
End If
Next
'Write array to the output sheet.
Sheet1.Cells(OUTPUT_ROW_START, OUTPUT_COL).Resize(UBound(output, 1), UBound(output, 2)).Value = output

Answer 2

So I think this will let you dynamically pick the size of your data set. I'm assuming that the column headers will always be at Row 5 as pictured. It loops through each input column and provides a unique output in H, I, and J. Disclaimer: I didn't get to test this as I'm not on my work PC.
Sub MixTheStuff()
'sets size of data in A (Set). -5 for the header row as noted
x = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row - 5
'sets size of data in B (#)
y = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 2).End(xlUp).Row - 5
'sets size of data in E (Animal)
z = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 5).End(xlUp).Row - 5
i=6 'First row after the headers
For sThing = 1 to x 'set thing
For nThing = 1 to y 'number thing
For aThing = 1 to z 'animal thing
'Pastes the value of the stuff (Set, #, and Animal respectively)
ThisWorkbook.Sheets("Data").cell(i,10) = ThisWorkbook.Sheets("Data").cell(x,1).value
ThisWorkbook.Sheets("Data").cell(i,11) = ThisWorkbook.Sheets("Data").cell(y,2).value
ThisWorkbook.Sheets("Data").cell(i,12) = ThisWorkbook.Sheets("Data").cell(z,5).value
i = i + 1 'Go to the next output row
Next sThing
Next nThing
Next aThing
End Sub

Answer 3

Sort of Unpivot
This will allow you to handle maximally 1023 animals.
The Code
Option Explicit
Sub SortOfUnpivot()
Const FirstRow As Long = 6
Const LastRowCol As String = "E"
Const dstFirstCell As String = "H6"
Dim srcCols As Variant
srcCols = VBA.Array("A", "B", "E")
Dim LB As Long
LB = LBound(srcCols)
Dim UB As Long
UB = UBound(srcCols)
Dim srcCount As Long
srcCount = UB - LB + 1
Dim LastRow As Long
LastRow = Cells(Rows.Count, LastRowCol).End(xlUp).Row
Dim rng As Range
Set rng = Cells(FirstRow, LastRowCol).Resize(LastRow - FirstRow + 1)
Dim Source As Variant
ReDim Source(LB To UB)
Dim j As Long
For j = LB To UB
Source(j) = rng.Offset(, Columns(srcCols(j)).Column - rng.Column).Value
Next j
Dim UBS As Long
UBS = UBound(Source(UB))
Dim Dest As Variant
ReDim Dest(1 To UBS ^ 2, 1 To srcCount)
Dim i As Long
Dim k As Long
For j = 1 To UBS
k = k + 1
For i = 1 + (j - 1) * UBS To UBS + (j - 1) * UBS
Dest(i, 1) = Source(0)(k, 1)
Dest(i, 2) = Source(1)(k, 1)
Dest(i, 3) = Source(2)(i - (j - 1) * UBS, 1)
Next i
Next j
Range(dstFirstCell).Resize(UBound(Dest), srcCount).Value = Dest
End Sub