Macro help - Autofill multiple cells to dynamic range

[smcnair2001]

Hello - I have hit a wall with my limited VBA knowledge & have scoured the internet but haven't found a solution that worked for me.
I'm usually able to piecemeal a solution together with a few similar examples of solutions, so I've ordered a VBA book for dummies to go ahead and try to actually learn how to do what I'm doing vs backwards engineering solutions; in the meantime, I'm hoping someone can assist with a solution for this specific issue:

I have a workbook where weekly data is added to one tab for manipulation. In this tab, I have a macro that will distribute the rows of data to the 12 Country Data Tabs that they correspond with regionally.
There are 6 columns with data that are copied (A:E). The data is appended to the first available blank row in column A to the Country Data Tabs on a weekly basis.
I have a macro that does this first step and now want to create a macro that will copy the formulas down in the rows that will analyze this data in those newly populated cells.
This is where I need the assistance.

So, I have several different types of formulas in columns G:N that need to be autofilled from the last used row. Some of the formulas in G:N change, depending on the daylight savings time or other variables as the weeks pass, so this is why I can't just copy the formulas from G2 down. I validate on a weekly basis that the existing formulas are all good to go before adding the new data. If new tweaks to the formulas are needed, then I add the adjusted formulas to the first available blank row, so that it can be copied down and applied to the new weeks' data.

I need the formulas in G:N to be autofilled down to the last used row in column A, so the last populated rows of G:N should be equal to the last populated row of column A. There are no blanks in column A.
I found a lot of solutions that brought the formulas down from the top, but didn't see any that autofilled from the bottom.

I am using Excel in Office 2010 & I have tried several potential solutions, but none were working.
I am fine with incorporating something containing:

Range("G666666").End(xlUp).Select

Worst case, I repeat the formula multiple times for columns H, I, J, K, L, M & N
I'm betting the range can be defined to capture columns G:N in one pass, though.

This is my only working code at the moment, which grabs the AutoFill from the top instead of the bottom:

Dim endRow As Long
endRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("G2:N2").AutoFill Destination:=Range("G2:N" & endRow)

Any assistance would be greatly appreciated. Thanks!

[Paul_Hossler]

Try this FillFormulas macro

I also had to delete the 12K duplicate styles and all the names that were missing a reference

Sub DelStyles()
    Dim i As Long
    
    For i = ThisWorkbook.Styles.Count To 1 Step -1
        If Not ThisWorkbook.Styles(i).BuiltIn Then ThisWorkbook.Styles(i).Delete
    Next i
End Sub


Sub DelNames()
    Dim i As Long
    
    For i = ThisWorkbook.Names.Count To 1 Step -1
        On Error Resume Next
        ThisWorkbook.Names(i).Delete
        On Error GoTo 0
    Next i
End Sub


'copy G2:N2 to bottom
Sub FillFormulas()
    Dim r As Range, s As Range, d As Range
    
    Set r = Worksheets("Country1").Cells(1, 1).CurrentRegion
    Set s = r.Cells(2, 7).Resize(1, 8)
    Set d = r.Cells(2, 7).Resize(r.Rows.Count - 1, 8)
    s.Copy d
End Sub

[smcnair2001]

Wow - thanks for pointing out the duplicate styles. I don't use styles, so hadn't noticed how cluttered that become. I googled it and found a couple of other solutions - yours worked better for delete styles, by several minutes. So, that worked great. The macro for the Names was interesting. I wanted to verify what I was deleting, so went to the Formulas tab, clicked on the Name Manager & reviewed the list. It was all unnecessary, but there is a way to select all of those and delete right there in the Name Manager, so I skipped the second macro.

The 3rd macro does take the formulas from G2:N2 and copy them down. However, what I need is the formulas to be copied from the bottom of the range, rather from the top. So, when the weekly data is copied into this tab, there will be maybe 20 rows that will go to the bottom of rows A:F. I don't want the fill down started from the top of column, but rather from the last populated cells. That way, if I have to modify the formulas in G:N, I just modify it before executing the code so that the original accurate formulas are retained for the point of time in which they were used. So, if A52:F62 is populated with new data, I want to grab the formulas in G51:N51 and autofill to row 62 (or whatever method allows me to copy that bottom range down).

[Paul_Hossler]

This version will copy the yellow line formulas into each of the green lines

Is that what you were looking to do?


Capture.JPG

Sub FillFormulas()
    Dim r As Range, s As Range, d As Range
    
    Set r = Worksheets("Country1").Cells(1, 1).CurrentRegion
    Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8)
    s.Copy d
End Sub

[smcnair2001]

Paul, that is exactly what I needed. You are the man! On the single page, that worked like magic.

How can I apply this to multiple sheets? Using the below code, I received a "Compile error: Duplicate declaration in current scope" when adding the other tabs; There are 13 tabs, so I'd rather not cut 13 macros. Tried adding the "With" & "End With" to bookend each tab's code, but still getting the error.

Sub FillFormulas
'
    Sheets("Sheet1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Dim r As Range, s As Range, d As Range
    Set r = Worksheets("Sheet1").Cells(1, 1).CurrentRegion
    Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8)
    s.Copy d
     
 
    With Sheets("Sheet2").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Dim r As Range, s As Range, d As Range
    Set r = Worksheets("Sheet2").Cells(1, 1).CurrentRegion
    Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8)
    s.Copy d
    End With

[smcnair2001]

Believe I've figured this out. So, what I was hoping to do was copy & paste, but I had to just plan it (should have known it wouldn't be that easy)
So, I took your original code, then just modified the Dim of r, s, & d as being unique letters to each sheet (& then adding double letters like AB & AC once I ran all the way through the alphabet.
Below is what I ended up with. Will run it through some QA, but I think that did it.

Sub FillFormulas()
'
' FillFormulas Macro
'
'
    Sheets("Data1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.EntireRow.Range("A1").Select
    Dim A As Range, B As Range, C As Range
    Set A = Worksheets("Data1").Cells(1, 1).CurrentRegion
    Set B = A.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set C = B.Cells(1, 1).Offset(1, 0).Resize(A.Rows.Count - B.Row, 8)
    B.Copy C

    Sheets("Data2").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.EntireRow.Range("A1").Select
    Dim D As Range, E As Range, F As Range
    Set D = Worksheets("Data2").Cells(1, 1).CurrentRegion
    Set E = D.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set F = E.Cells(1, 1).Offset(1, 0).Resize(D.Rows.Count - E.Row, 8)
    E.Copy F

    Sheets("Data13").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.EntireRow.Range("A1").Select
    Dim AK As Range, AL As Range, AM As Range
    Set AK = Worksheets("Data13").Cells(1, 1).CurrentRegion
    Set AL = AK.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set AM = AL.Cells(1, 1).Offset(1, 0).Resize(AK.Rows.Count - AL.Row, 8)
    AL.Copy AM

    Sheets("RawData-Temp").Select
    Range("A1").Select
    
End Sub

[smcnair2001]

Verified that this works. Thanks for the assistance Paul!!! You rock!

[Paul_Hossler]

Didn't test, but this is another way to consider

Don't need to create a lot of essentially redundant variables, but just loop through the worksheets, optionally skipping selected ones


The important thing is the 'ws.' on the Set r line

 Option Explicit

 Sub FillFormulas_1()
     Dim r As Range, s As Range, d As Range
     Dim ws As Worksheet
      
     For Each ws In ActiveWorkbook.Worksheets

         Select Case ws.Name

             Case "Skip", "This Also", "Another One"
                 'do nothing

             Case Else
                 Set r = ws.Cells(1, 1).CurrentRegion
                 Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8)
                 Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8)
                 s.Copy d

         End Select

     Next
     
 End Sub

[mdmackillop]

Alternative technique is to pass variables to another sub

Sub Test()
Dim arr, a
arr = Array("Data1", "Data2", "Data3")
For Each a In arr
Call FillFormulas(a)
Next a
Application.Goto Sheets("RawData-Temp").Range("A1")
End Sub


Sub FillFormulas(Data)
    Sheets(a).Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.EntireRow.Range("A1").Select
    Dim a As Range, B As Range, C As Range
    Set a = Worksheets(a).Cells(1, 1).CurrentRegion
    Set B = a.Cells(2, 7).End(xlDown).Resize(1, 8)
    Set C = B.Cells(1, 1).Offset(1, 0).Resize(a.Rows.Count - B.Row, 8)
    B.Copy C
 End Sub

[Paul_Hossler]

Believe I've figured this out.

Why are you Selecting the last cell, and then right away row 1?

    ActiveCell.SpecialCells(xlLastCell).Select 
    ActiveCell.EntireRow.Range("A1").Select

Usually there's no need to Select something to work with it

My example in #4 had no .Select's at all

[smcnair2001]

I was using select to just make sure that each worksheet ended up at the bottom so that when I tab through for visual validation, it's where it needs to be.
Knew there was probably an easier way to define all of that, but I'm basically a blunt hammer. I think mdmackillop's solution was a little easier for me to understand. I've never used Case Select before.
Would like to verify that I'm making the correct assumption on where to stick the workbook names:

Option Explicit 
 
Sub FillFormulas_1() 
    Dim r As Range, s As Range, d As Range 
    Dim ws As Worksheet 
     
    For Each ws In ActiveWorkbook.Worksheets 
         
 Select Case Sheets("Data1")
        Case Else 
            Set r = ws.Cells(1, 1).CurrentRegion 
            Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8) 
            Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8) 
            s.Copy d 
        End Select 
         
 Select Case Sheets("Data2")
        Case Else 
            Set r = ws.Cells(1, 1).CurrentRegion 
            Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8) 
            Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8) 
            s.Copy d 
         End Select
     
 Select Case Sheets("Data13")
        Case Else
            Set r = ws.Cells(1, 1).CurrentRegion 
            Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8) 
            Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8) 
            s.Copy d 
        End Select  
     
End Sub

Looking at that - I don't even think that's close to being right... Can you show me where the tab names would go in yours, Paul? There are also 13 pivot table tabs in the workbook, so I wasn't sure about pointing the code at "Each ws in ActiveWorkbook.Worksheets" since I only want to touch the 13 data tabs. This one definitely looked like it was a little more straightforward:

Sub Test() 
    Dim arr, a 
    arr = Array("Data1", "Data2", "Data13") 
    For Each a In arr 
        Call FillFormulas(a) 
    Next a 
    Application.Goto Sheets("RawData-Temp").Range("A1") 
End Sub 
 
 
Sub FillFormulas(Data) 
    Sheets(a).Select 
    ActiveCell.SpecialCells(xlLastCell).Select 
    ActiveCell.EntireRow.Range("A1").Select 
    Dim a As Range, B As Range, C As Range 
    Set a = Worksheets(a).Cells(1, 1).CurrentRegion 
    Set B = a.Cells(2, 7).End(xlDown).Resize(1, 8) 
    Set C = B.Cells(1, 1).Offset(1, 0).Resize(a.Rows.Count - B.Row, 8) 
    B.Copy C 
End Sub

Thanks to you both for your patience. Babysteps to actually understanding what I'm coding...

[Paul_Hossler]

Going back to this version,

1. it looks at all worksheets (For Each ws ...)

2. Case "Skip", "This Also", "Another One" was the exceptions list, i.e. don't do anything on these

3. Else do the fill down logic on the sheet

Option Explicit 
 
Sub FillFormulas_1() 
    Dim r As Range, s As Range, d As Range 
    Dim ws As Worksheet 
     
    For Each ws In ActiveWorkbook.Worksheets 
         
        Select Case ws.Name 
             
        Case "Skip", "This Also", "Another One" 
             'do nothing
             
        Case Else 
            Set r = ws.Cells(1, 1).CurrentRegion 
            Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8) 
            Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8) 
            s.Copy d 
             
        End Select 
         
    Next 
     
End Sub

Now if there's a 'signature' in the appropriate sheets (e.g. A1 = "Report" OR THE NAME STARTS with Data...)

The macro can be smarter

Option Explicit

Sub FillFormulas_1()
    Dim r As Range, s As Range, d As Range
    Dim ws As Worksheet
     
    For Each ws In ActiveWorkbook.Worksheets
         
        If Left(ws.Name, 4) = "Data" Then
            Set r = ws.Cells(1, 1).CurrentRegion
            Set s = r.Cells(2, 7).End(xlDown).Resize(1, 8)
            Set d = s.Cells(1, 1).Offset(1, 0).Resize(r.Rows.Count - s.Row, 8)
            s.Copy d
             
        End If
         
    Next
     
End Sub

Here's a very simplified demo of the Data... name approach

Sub FillFormulas_Msg()
    Dim ws As Worksheet
     
    For Each ws In ActiveWorkbook.Worksheets
         
        If Left(ws.Name, 4) = "Data" Then
            MsgBox "Do " & ws.Name
        Else
            MsgBox "Do NOT do " & ws.Name
        End If
         
    Next
     
End Sub

[smcnair2001]

Thanks for the explanation! Much appreciated!!!