PDA

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.