PDA

View Full Version : [SOLVED] Macro help - Autofill multiple cells to dynamic range



smcnair2001
05-16-2017, 09:53 AM
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. :banghead:
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
05-17-2017, 09:16 PM
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
05-18-2017, 06:58 AM
Wow - thanks for pointing out the duplicate styles. :thumb 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
05-18-2017, 07:47 AM
This version will copy the yellow line formulas into each of the green lines

Is that what you were looking to do?


19211







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
05-18-2017, 09:41 AM
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
05-18-2017, 11:57 AM
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
05-18-2017, 02:19 PM
Verified that this works. Thanks for the assistance Paul!!! You rock! :bow:
:clap:

Paul_Hossler
05-19-2017, 06:28 AM
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
05-19-2017, 07:03 AM
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
05-19-2017, 07:09 AM
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
05-19-2017, 09:17 AM
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
05-19-2017, 03:21 PM
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
05-22-2017, 07:15 AM
Thanks for the explanation! Much appreciated!!!:hi: