Forum Discussion
Can VBA dynamically insert data in rows on one worksheet based on the number rows w. data on another
Windows 10
Excel 2019
Is possible for VBA dynamically insert data in rows on one worksheet based on the number rows on another worksheet in the same workbook?
I have a workbook with two worksheets named "Title Data" and "Track Data".
Both worksheets have headers.
The number of rows with data in worksheet "Track Data" can vary, new data maybe added, and some may be deleted.
The VBA code below pulls selected data from "Track Data" in to "Title Data" .
I have to manually specify the number of rows which I have set at 50000 in code as seen in the snippit...
Range("A2:I2").Select
Selection.AutoFill Destination:=Range("A2:I50000"), Type:=xlFillDefault
At the moment there is only 33,105 rows with data so I see no point in adding more rows of formulas than is needed as the code takes a while to run as it is.
Can the above code snippit be dynamic where the VBA, when it is run, looks in the "Track Data" worksheet and counts the number of rows with data and then copies the formulas into "Title Data" and only fills the forumalas down to match the number of rows with data in "Track Data" ?
So if there are 10,000 rows in "Track Data" with data, the VBA the copies the formulas down 10,000 rows in "Title Data" and if there are 90,000 rows then it adds 90,000 rows of formulas.
I may be thinking rubbish but if I do not ask then I will not know the answer as this is beyond my knowledge.
Thank you everyone.
Sub PullTitlesDataTest2()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableAnimations = False
End With
' Starting with cell A2 through to cell I2, and down to row 40,000, this inserts the forumlas to
' pull the data from the worksheet "Track Data*
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC),"""",'Track Data'!RC)"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-1]),"""",'Track Data'!RC)"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-2]),"""",'Track Data'!RC[6])"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-3]),"""",'Track Data'!RC[6])"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-4]),"""",'Track Data'!RC)"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(RC[-5]=R[1]C[-5],RC[-4]=R[1]C[-4],RC[-3]=R[1]C[-3],RC[-2]=R[1]C[-2]),"""",TEXTJOIN(""+"",,CHOOSE({1,2},IF(COUNTIFS(R2C[-1]:RC[-1],1,R2C[-4]:RC[-4],RC[-4]),""M"",""""),IF(COUNTIFS(R2C[-1]:RC[-1],2,R2C[-4]:RC[-4],RC[-4]),""S"",""""),2)))"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-6]),"""",'Track Data'!RC[-1])"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-7]),"""",'Track Data'!RC[-1])"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-8]),"""",IF('Track Data'!RC[-1]="".wav"",""Wav"",IF('Track Data'!RC[-1]="".flac"",""Flac"",IF('Track Data'!RC[-1]="".aif"",""Aif"",IF('Track Data'!RC[-1]="".mp3"",""MP3"",IF('Track Data'!RC[-1]="".SD2"",""SD2"",""UNKNOWN TYPE""))))))"
Range("A2:I2").Select
Selection.AutoFill Destination:=Range("A2:I40000"), Type:=xlFillDefault
Range("A2:I40000").Select
Application.GoTo Reference:="R2C1"
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableAnimations = True
End With
End Sub
Try this:
Sub PullTitlesDataTest2() Dim LastRow As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableAnimations = False End With LastRow = Worksheets("Track Data").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' Starting with cell A2 through to cell I2, and down to row 40,000, this inserts the forumlas to ' pull the data from the worksheet "Track Data* Range("A2:A" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC),"""",'Track Data'!RC)" Range("B2:B" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-1]),"""",'Track Data'!RC)" Range("C2:C" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-2]),"""",'Track Data'!RC[6])" Range("D2:D" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-3]),"""",'Track Data'!RC[6])" Range("E2:E" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-4]),"""",'Track Data'!RC)" Range("F2:F" & LastRow).FormulaR1C1 = "=IF(AND(RC[-5]=R[1]C[-5],RC[-4]=R[1]C[-4],RC[-3]=R[1]C[-3],RC[-2]=R[1]C[-2]),"""",TEXTJOIN(""+"",,CHOOSE({1,2},IF(COUNTIFS(R2C[-1]:RC[-1],1,R2C[-4]:RC[-4],RC[-4]),""M"",""""),IF(COUNTIFS(R2C[-1]:RC[-1],2,R2C[-4]:RC[-4],RC[-4]),""S"",""""),2)))" Range("G2:G" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-6]),"""",'Track Data'!RC[-1])" Range("H2:H" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-7]),"""",'Track Data'!RC[-1])" Range("I2:I" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-8]),"""",IF('Track Data'!RC[-1]="".wav"",""Wav"",IF('Track Data'!RC[-1]="".flac"",""Flac"",IF('Track Data'!RC[-1]="".aif"",""Aif"",IF('Track Data'!RC[-1]="".mp3"",""MP3"",IF('Track Data'!RC[-1]="".SD2"",""SD2"",""UNKNOWN TYPE""))))))" Application.GoTo Reference:="R2C1" With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableAnimations = True End With End Sub
Try this:
Sub PullTitlesDataTest2() Dim LastRow As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableAnimations = False End With LastRow = Worksheets("Track Data").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' Starting with cell A2 through to cell I2, and down to row 40,000, this inserts the forumlas to ' pull the data from the worksheet "Track Data* Range("A2:A" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC),"""",'Track Data'!RC)" Range("B2:B" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-1]),"""",'Track Data'!RC)" Range("C2:C" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-2]),"""",'Track Data'!RC[6])" Range("D2:D" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-3]),"""",'Track Data'!RC[6])" Range("E2:E" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-4]),"""",'Track Data'!RC)" Range("F2:F" & LastRow).FormulaR1C1 = "=IF(AND(RC[-5]=R[1]C[-5],RC[-4]=R[1]C[-4],RC[-3]=R[1]C[-3],RC[-2]=R[1]C[-2]),"""",TEXTJOIN(""+"",,CHOOSE({1,2},IF(COUNTIFS(R2C[-1]:RC[-1],1,R2C[-4]:RC[-4],RC[-4]),""M"",""""),IF(COUNTIFS(R2C[-1]:RC[-1],2,R2C[-4]:RC[-4],RC[-4]),""S"",""""),2)))" Range("G2:G" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-6]),"""",'Track Data'!RC[-1])" Range("H2:H" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-7]),"""",'Track Data'!RC[-1])" Range("I2:I" & LastRow).FormulaR1C1 = "=IF(ISBLANK('Track Data'!RC[-8]),"""",IF('Track Data'!RC[-1]="".wav"",""Wav"",IF('Track Data'!RC[-1]="".flac"",""Flac"",IF('Track Data'!RC[-1]="".aif"",""Aif"",IF('Track Data'!RC[-1]="".mp3"",""MP3"",IF('Track Data'!RC[-1]="".SD2"",""SD2"",""UNKNOWN TYPE""))))))" Application.GoTo Reference:="R2C1" With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableAnimations = True End With End Sub
- Kenneth GreenBrass Contributor