Loop through data and build an array

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,802
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

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

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,802
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,593
Messages
5,487,755
Members
407,610
Latest member
bellakim00

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top