Avatar of Andreas Hermle
Andreas Hermle
Flag for Germany asked on

Enter the same formula into worksheets and copy it down using VBA

Dear Experts:

I would like to enter the following formula into M5 of all the worksheets of the active workbook:

=IF(A5<>SUM(E5:G5);"Caution!";"ok")

The following requirements have to be regarded

Requirement 1: macro is to skip the following worksheets
1_Index
2_Results
3_Overall_List
X_Data
Y_Requirements
Z_Miscellaneous

Requirement 2: the filled in formula '=IF(A5<>SUM(E5:G5);"Caution!";"ok")' is to be copied down, based on the last filled cell in the adjacent column L

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
VBAMicrosoft ExcelMicrosoft Office

Avatar of undefined
Last Comment
Shums Faruk

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Shums Faruk

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Subodh Tiwari (Neeraj)

You may try something like this....

If you use a ; (semicolon) in the formula instead of a , (comma), replace comma in line#5 with semicolon.
Sub PlaceFormula()
Dim ws As Worksheet
Dim lr As Long
Dim Formula As String
Formula = "IF(A5<>SUM(E5:G5),""Caution!"",""ok"")"
For Each ws In Worksheets
    Select Case ws.Name
        Case "Index", "Results", "Overall_List", "Data", "Requirements", "Miscellaneous"
        
        Case Else
            lr = ws.Cells(Rows.Count, "L").End(xlUp).Row
            If lr > 4 Then
                ws.Range("M5:M" & lr).Formula = "=" & Formula
            End If
    End Select
    lr = 0
Next ws
End Sub

Open in new window

Andreas Hermle

ASKER
Hi Shums,

works great, thank you very much for it. As a matter of fact, I forgot to mention another requirement.

The user is to be prompted via InputBox in which column the formula is to be entered, i.e. it also could be Column N (N5) or Column O (O5) or whatever for example.  The copying down of the formula should then be based on the respective column left of the chosen Column Letter. I hope this is not too much asking.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Andreas Hermle

ASKER
Hi Neeraj,

thank you very much for it. I will test your code shortly, Thank you very much

Regards, andreas
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
SOLUTION
Subodh Tiwari (Neeraj)

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Andreas Hermle

ASKER
Hi Neeraj,

Thank you very much for it. I am afraid to tell you that your code threw an error message.

I was able to tweak the code based on your nice coding.

Line 10-14 and line 25 have been added by me and I commented out the following lines of your code, because this threw an error message.

On Error Resume Next
Set rng = Application.InputBox("Select any cell in column where you want to place the formula.", "Choose Formula Column!", Type:=8)
On Error GoTo 0
If rng Is Nothing Then
    MsgBox "You didn't select a formula column.", vbExclamation
    Exit Sub
End If
Col = rng.Column

Sub PlaceFormula_2()
Dim ws As Worksheet
Dim rng As Range
Dim lr As Long, Col As Long
Dim Formula As String
Formula = "IF(A5<>SUM(E5:G5),""Caution!"",""ok"")"
Dim ColName As String


ColName = InputBox("choose column letter", "Set Column Letter")
If ColName = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If




Application.ScreenUpdating = False
For Each ws In Worksheets
    Select Case ws.Name
         Case "1_Index", "2_Auswertung", "3_Gesamtliste", "X_Sorting", "Y_ColumnHeader", "Z_Requirements"
        
        Case Else
            lr = ws.Cells(Rows.Count, "L").End(xlUp).Row
            If lr > 4 Then
                ws.Range(ws.Cells(5, Range(ColName & 1).Column), ws.Cells(lr, Range(ColName & 1).Column)).Formula = "=" & Formula
            End If
    End Select
    lr = 0
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window



There is one thing you could help me with: I would like you to add error trapping to this code snippet, i.e. only column letters are allowed to be entered into the InputBox, nothing else ...

Dim ColName As String
ColName = InputBox("choose column letter", "Set Column Letter")
If ColName = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

Open in new window

Andreas Hermle

ASKER
Hi Neeraj,

found out myself ...

Sub test()
Dim MyTestRange As Range, MyCol As String
MyCol = Application.InputBox("Enter column Letter", , , , , , , 2)
On Error Resume Next
Set MyTestRange = Range(MyCol & 1)
If Not MyTestRange Is Nothing Then
    MsgBox "valid column entry"
Else
    MsgBox "INvalid column entry"
End If
End Sub
Andreas Hermle

ASKER
Dear both,

I can use both codes, tweaking both of them to my liking. Thank you very much for your valuable and professional help. Regards, Andreas
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Shums Faruk

You're Welcome Andreas! Glad we're able to help and you found the solution.