Loop through data and build an array

[2077delta]

I have a sheet of data, not in table form, more like a report with blocks of data that repeat themselves as you go down the page. I want to go through the data and extract some of the data and copy it to a different worksheet. I was thinking of using the Find function to locate where each block of data starts (Find "Employee No."). I would then want to get the data offset 0 rows and 2 columns (Employee Name) and offset 5 rows and 4 columns, 5 rows and 5 columns, 5 rows and 6 columns, 5 rows and 7 columns and 6 rows and 7 columns (the payroll data), to build a table that looks like this:

Joe Greene 3251.23 721.43 218.57 25.12 2286.11
Deacon Jones 3516.67 801.33 266.82 31.48 2417.04
So on and so forth

I understand the best way to do this is to build an array then paste it into my spreadsheet. Obviously, I'm not really sure how I do that. Any help would be greatly appreciated as I have several other tasks I could apply this same routine to.

 

[Fluff]

Not overly neat, but seems to do what you want.

Sub delta()
   Dim i As Long, j As Long
   Dim Ar1 As Areas, Ar2 As Areas
   Dim Ary As Variant, x As Variant
   
   Ary = Array("Work", 2, "Sick", 3, "Vacation", 4, "Meal Premium", 5)
   With Range("C:C")
      .Replace "Name", "=xxxName", xlWhole, , False, , False, False
      Set Ar1 = .SpecialCells(xlFormulas, xlErrors).Areas
      .Replace "=xxxName", "Name", xlWhole, , False, , False, False
   End With
   With Range("M:M")
      .Replace "Pay", "=xxxPay", xlPart, , False, , False, False
      Set Ar2 = .SpecialCells(xlFormulas, xlErrors).Areas
      .Replace "=xxx", "", xlPart, , False, , False, False
   End With

   With Sheets("Sheet2")
      For i = 1 To Ar1.Count
         .Cells(i + 1, 1) = Ar1(i).Offset(1)
         For j = 1 To Ar2(i).Offset(1, 2).CurrentRegion.Rows.Count
            x = Application.Match(Ar2(i).Offset(j, 2), Ary, 0)
            If Not IsError(x) Then
               .Cells(i + 1, Ary(x)) = Ar2(i).Offset(j, 10).Value
               If x = 1 Then .Cells(i + 1, 6) = Ar2(i).Offset(j, 12).Value
            Else
               .Cells(i + 1, 6) = Ar2(i).Offset(1, 12).Value
            End If
         Next j
      Next i
   End With
End Sub

 

[2077delta]

Fluff,

My apologies for such a late thank you. This worked great and was lightning fast. Can you explain how it works? I'm not quite sure how the top half and bottom half work together (obviously I'm not a programmer and envy those of you who are). I have many uses for this so to the degree I can understand the mechanics, I'll be able to modify it for future uses.

P.S. Really like the rose. My grandmother had a rose garden and pictures of them bring back the fondest of memories. Chippenham, is that in England? If so hope you all are surviving your record heat. Where I'm at it's supposed to be 110° F tomorrow, but still 8 degrees shy of our record.

 

[Fluff]

You're welcome & thanks for the feedback.

I'll write up a brief description, when I get a moment.