Loop through data and build an array

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,721
Office Version
365
Platform
Windows
Not overly neat, but seems to do what you want.
Code:
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
 
Last edited:

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

2077delta

Board Regular
Joined
Feb 17, 2002
Messages
241
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,721
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback.

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

Watch MrExcel Video

Forum statistics

Threads
1,102,450
Messages
5,486,969
Members
407,575
Latest member
calc

This Week's Hot Topics

Top