Fill remaining cell based on which column is entered

Question

I want to be able to do the following:

     D       E                           F
1    P       Q                           pf
2    100     =D2/F2*SIN(ACOS(F2))        =D2/SQRT((D2^2+E2^2))
3    200     =D3/F3*SIN(ACOS(F3))        =D3/SQRT((D3^2+E3^2))
4
5    P       Q                           pf
6    100     =D6/F6*SIN(ACOS(F6))        =D6/SQRT((D7^2+E6^2))
7    200     =D7/F7*SIN(ACOS(F7))        =D7/SQRT((D7^2+E7^2))

That is, if I enter a value in column F, the value in column E should automatically be filled in, and if I enter a value in column E, the value in column F should automatically be filled in.

But, I don't want to display #DIV/0!, before I enter the value.

Objective:

1. Check if column D contains a number.
2. Check if either column column E or F contains a number
3. Fill in the remaining column

Also, I will enter names in some of the rows, thus these must be disregarded. I know I can drag the equations down and achieve it that way, but then again, that will give me #DIV/0!.

Is there a clever way to do this? I'm using Excel 2010.

Answer 1

• Open VBE (Visual Basic Editor) ALT+F11
• Right-click in the Project Explorer and Insert a Module
• Paste the below code

UDF functions

Function E()

    Dim D As Range, F As Range
    Set D = ActiveCell.Offset(0, -1): Set F = ActiveCell.Offset(0, 1)
    
    If Len(D) = 0 Or Len(F) = 0 Then E = ""
    If Len(F) > 0 Then
        Dim result As Double
        result = Evaluate("=" & D & "/" & F & "*SIN(ACOS(" & F & "))")
        E = result
    End If
End Function

Function F()
    Dim D As Range, E As Range
    Set D = ActiveCell.Offset(0, -2): Set E = ActiveCell.Offset(0, -1)
    
    If Len(D) = 0 Or Len(E) = 0 Then F = ""
    If Len(E) > 0 Then
        Dim result As Double
        result = Evaluate("=" & D & "/SQRT((" & D & "^2+" & E & "^2))")
        F = result
    End If
End Function

• Go back to your spreadsheet and enter new formulas
• Cell E2 is now =E() and cell F2 is now =F() drag the formulas down

Ended up with

Update:

To automate the insertion and calculation

In the Project Explorer » right-click Sheet1 » View Code

Insert the below code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 5 Then
        FillF Target
    ElseIf Target.Column = 6 Then
        FillE Target
    End If
End Sub

In the Module1 replace the code you have with the one below

Option Explicit

Sub FillF(ByVal Target As Range)
    
    Dim D As Range, E As Range, F As Range

    Set E = Target
    Set D = E.Offset(0, -1)
    Set F = E.Offset(0, 1)
    
    If Not IsError(E) Then
        If Len(E) = 0 Then
            Exit Sub
        ElseIf Len(D) = 0 Then
            Exit Sub
        ElseIf Len(D) > 0 And Len(F) = 0 Then
            F.Formula = "=" & D & "/SQRT((" & D & "^2+" & E & "^2))"
            Exit Sub
        Else
            Exit Sub
        End If
    Else
        F.ClearContents
    End If
    
End Sub

Sub FillE(ByVal Target As Range)
    
    Dim D As Range, E As Range, F As Range
    
    Set F = Target
    Set E = F.Offset(0, -1)
    Set D = F.Offset(0, -2)
    
    If Not IsError(F) Then
        If Len(F) = 0 Then
            Exit Sub
        ElseIf Len(D) = 0 Then
            Exit Sub
        ElseIf Len(D) > 0 And Len(E) = 0 Then
            E.Formula = "=" & D & "/" & F & "*SIN(ACOS(" & F & "))"
            Exit Sub
        Else
            Exit Sub
        End If
    Else
        E.ClearContents
    End If

End Sub

Now, Go to you spreadsheet and enter a number either in column E, or F the other formula should be calculated and the result should appear in the neighbouring cell.