View Full Version : Excel VBA insert Formulas below a table
Manito
10-07-2015, 06:09 AM
Dear VBA Express community,
I would like to generate a code that automatically inserts Formulas and Text in the first 4 empty rows below a formerly created new worksheet (see picture). Does anyone have an idea how I can do this? The formulas are always the same.
14521
Thank you very much in advance.
Best
Manito
p45cal
10-07-2015, 04:03 PM
Give us the code that adds the data to the new sheet and we'll add to it.
It might be something like:
Sub blah()
With Range("A9").CurrentRegion
  Z = .Columns(4).Address(0)
  With Cells(.Cells(.Cells.Count).Row + 1, 3)
    .Resize(4).Value = Application.Transpose(Array("Sum", "Avg", "Min", "Max"))
    .Offset(, 1).Formula = "=Sum(" & Z & ")"
    .Offset(1, 1).Formula = "=AVERAGE(" & Z & ")"
    .Offset(2, 1).Formula = "=Min(" & Z & ")"
    .Offset(3, 1).Formula = "=Max(" & Z & ")"
  End With
End With
End Sub
Manito
10-07-2015, 04:58 PM
Thanks a lot for you quick answer. Here is the code
Sub extractJ2Dept()
'
' extractJ2Dept Macro
' Extracting the department selected in J2
'
'
    Dim vNameDpt
    vNameDpt = Sheets("HR").Range("J2").Value
    Sheets.Add After:=Sheets(Sheets.Count)
    'ActiveSheet.Select 'It's the sheet we are on so it's redundant
    ActiveSheet.Name = vNameDpt
    Sheets("HR").Select
    Range("B1,C1,D1,F1").Select
    'Range("F1").Activate no need to have a specific cell activated
    Selection.Copy
    Sheets(vNameDpt).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("HR").Columns("A:F").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("HR").Range("J1:J2"), CopyToRange:=Range("A1:D1"), _
        Unique:=False
    Columns("A:D").Select
    Selection.Columns.AutoFit
   
End Sub
p45cal
10-07-2015, 05:20 PM
Difficult for me to test so test this for me:
Sub extractJ2Dept()
'
' extractJ2Dept Macro
' Extracting the department selected in J2
'
'
Dim vNameDpt
vNameDpt = Sheets("HR").Range("J2").Value
With Sheets.Add(After:=Sheets(Sheets.Count))
  .Name = vNameDpt
  Sheets("HR").Range("B1,C1,D1,F1").Copy .Range("A1")
  Sheets("HR").Columns("A:F").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("HR").Range("J1:J2"), CopyToRange:=.Range("A1:D1"), Unique:=False
  .Columns("A:D").Columns.AutoFit
  With .Range("A1").CurrentRegion
    Z = .Columns(4).Address(0)
    With Cells(.Cells(.Cells.Count).Row + 1, 3)
      .Resize(4).Value = Application.Transpose(Array("Sum", "Avg", "Min", "Max"))
      .Offset(, 1).Formula = "=Sum(" & Z & ")"
      .Offset(1, 1).Formula = "=AVERAGE(" & Z & ")"
      .Offset(2, 1).Formula = "=Min(" & Z & ")"
      .Offset(3, 1).Formula = "=Max(" & Z & ")"
    End With
  End With
End With
End Sub
Manito
10-08-2015, 06:47 AM
Perfect, thank you very much for the great help. It works!
Have a great day.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.