Fill down an array formula across multiple worksheets

AggyRJ

New Member
Joined
Mar 29, 2013
Messages
14
In short, what I need to be able to do is fill an array formula down in multiple worksheets. Within each sheet the formula needs to fill down a different number of times. I will give some background info so that this can be understood in context and then paste the code I currently have below that.

I am creating a macro that has a list of zip codes that are assigned to specific templates. The full list with template names and zip codes is in a worksheet titled ORDR Info. In a previous step, I have written a code which creates worksheets where each one is named with the template name and cell I1 has the template name. I need to move the zip codes that match the template name to the worksheet for that template (later I will export each worksheet as a separate .csv file).

In order to import the zip codes into each worksheet I am using an array formula in cell R1 which looks in the worksheets “ORDR Info” and returns the zip codes where the template matches the value in I1. The actual formula works fine, however the problem is that the array formula must be dragged down the same number of zip codes so that they are displayed in the list. For example, a template named “027_570” I have 115 zip codes, so I need the formula to populate in R1 and then fill down an additional 114 times.

What I thought I would do is create a helper cell in I2 using COUNTIF to return a value which represents how many times the template name is found and then have the array formula fill down that number of times. My issue is that I cannot figure out how to make this work with an array formula. The code I am using enters the formula as an array and fills it down the correct number of times, however it does it as a regular formula, not an array. My hope is that just that single line of code can be updated because everything else works.



Any help with this is GREATLY appreciated.

Code:
Sub Import_Zips()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
'Count the number of times the template name is shown in the Zones list
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF('ORDR Info'!C1,R1C9)=0,1,COUNTIF('ORDR Info'!C1,R1C9)-1)"
    Range("I2").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
'Array formula to find the match of template name and zip code
    Range("R1").Select
    Selection.FormulaArray = "=IFERROR(INDEX('ORDR Info'!C2,SMALL(IF(R1C9='ORDR Info'!C1,ROW('ORDR Info'!C1)-ROW('ORDR Info'!R2C1)+1),ROW(R[1]))),"""")"
'Fill down array formula the number of rows equal to the number of zip codes found in the template
    Range("R1:R" & Range("I2").Value).Formula = Range("R1").Formula
    Next
    
    Application.ScreenUpdating = True
    
End Sub
 

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,124
Office Version
365
Platform
Windows
Hi AggyRJ,
try something like this (untested):

Code:
Sub Import_Zips()

    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        'Count the number of times the template name is shown in the Zones list
        ws.Range("I2").FormulaR1C1 = "=IF(COUNTIF('ORDR Info'!C1,R1C9)=0,1,COUNTIF('ORDR Info'!C1,R1C9)-1)"
        ws.Range("I2").Copy
        ws.Range("I2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ws.Calculate 'Not sure if this is needed, but to make sure the value is updated
        'Array formula to find the match of template name and zip code
        'Fill down array formula the number of rows equal to the number of zip codes found in the template
        If ws.Range("I2").Value >= 1 Then
            ws.Range("R1:R" & ws.Range("I2").Value).FormulaArray = "=IFERROR(INDEX('ORDR Info'!C2,SMALL(IF(R1C9='ORDR Info'!C1,ROW('ORDR Info'!C1)-ROW('ORDR Info'!R2C1)+1),ROW(R[1]))),"""")"
        End If
    Next
    
    Application.ScreenUpdating = True
    
End Sub
Note that I did make some changes: when you record a macro a lot of .select and .activate statements are saved, but generally it is good practice not to use them when avoidable.

Hope this helps,
Koen
 

Forum statistics

Threads
1,078,437
Messages
5,340,271
Members
399,361
Latest member
Linford

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top