SOLVED

Can VBA dynamically insert data in rows on one worksheet based on the number rows w. data on another

Brass Contributor

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

 

2 Replies
best response confirmed by Kenneth Green (Brass Contributor)
Solution

@Kenneth Green 

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

@Hans Vogelaar 

 

Thank you Hans, that worked perfectly.

 

 

Best wishes

1 best response

Accepted Solutions
best response confirmed by Kenneth Green (Brass Contributor)
Solution

@Kenneth Green 

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

View solution in original post