How to automate simply supported beam subjected to point load with excel VBA?

Following a comment on this post on my YouTube channel from one of my viewer, I decided to share VBA codes on how to automate structural analysis tasks in excel using VBA (Visual basic for application) . In this post, I will focus on a simply supported beam subjected to  point load.

Simply supported beam with point load formulas

•  Reactions at supports

RA=P*(Length-dist)/Length

RB=P-RA

•  Bending Moment equation

Mx=RA * X                                                     if  dist>X

Mx=RA * X - P*(Length-dist)                         if X>dist

• Shear force equation

Shx=RA                                                        if  dist>X

Shx=RA  - P                                                  if X>dist

Excel VBA implementation

The VBA functions  below are the VBA  implementation of the simply supported beam formulas.

• Reaction at support A

Function Reaction1_PointLoad_Cal(Pload As Double, Dist As Double, Length As Double) As Double 'function declaration line with parameters(Pload,dist and Length)
    Reaction1_PointLoad_Cal = Pload * (Length - Dist) / Length 'Calculate the reaction at left support
End Function 'Closing function block

• Reaction at support B

Function Reaction2_PointLoad_Cal(Pload As Double, Dist As Double, Length As Double) As Double 'function declaration line with parameters(Pload,dist and Length)
     Reaction2_PointLoad_Cal = Pload - Reaction1_PointLoad_Cal(Pload, Dist, Length) 'Calculate the reaction at right support
End Function 'Closing function block

• Bending moment at a point X along the beam

Function BendingMoment_PointLoad_Cal(Pload As Double, x As Double, Dist As Double, Reaction1 As Double) As Double
    If Dist > x Then
         BendingMoment_PointLoad_Cal = Reaction1 * x
    ElseIf x > Dist Then
         BendingMoment_PointLoad_Cal = Reaction1 * x - Pload * (x - Dist)
    End If
End Function

•  Shear force at a point X along the beam

Function ShearForce_PointLoad_Cal(Pload As Double, x As Double, Dist As Double, Reaction1 As Double) As Double
       If Dist > x Then
            ShearForce_PointLoad_Cal = Reaction1
       ElseIf x > Dist Then
            ShearForce_PointLoad_Cal = Reaction1 - Pload
       End If
End Function

•  Get the maximum bending moment and position

Function GetMax_Moment(Moment() As Variant, Distcoll() As Variant) As Variant
  Dim temp As Double, i As Integer, n As Integer
  temp = 0
  For i = LBound(Moment) To UBound(Moment)
       If Abs(Moment(i)) > Abs(temp) Then
           temp = Moment(i)
           n = i
       End If
  Next i
   GetMax_Moment = Array(temp, Distcoll(n))
End Function

Sub routines to draw the diagrams

• Add chart to worksheet

Sub Chart_Add(name As String)
  Dim chr As ChartObject
   Chart_Delete (name)
   If name = "Bending Moment" Then 
       Set chr = ActiveSheet.ChartObjects.Add(155, 400, 450, 450)
   Else
      Set chr = ActiveSheet.ChartObjects.Add(155, 900, 450, 450)
   End If
   chr.name = name
With chr.Chart
     .HasTitle = True
     .HasLegend = False
     .ChartTitle.Text = name
     .ChartType = xlXYScatterLinesNoMarkers
     .Axes(xlCategory).HasMajorGridlines = True
     .Axes(xlCategory).MajorUnit = 1
     .Axes(xlValue).HasMajorGridlines = True
     .Axes(xlValue).MajorUnit = 1 
End With
End Sub

•  Add data  to the chart

Sub Chart_Add_Data(Xvalue() As Variant, Yvalue() As Variant, name As String)
  Dim m As Integer
ActiveSheet.ChartObjects(name).Activate
With ActiveChart
   m = .SeriesCollection.Count
    .SeriesCollection.NewSeries
    .SeriesCollection(m + 1).XValues = Xvalue()
    .SeriesCollection(m + 1).Values = Yvalue()
    .SeriesCollection(m + 1).name = name
End With
End Sub

• Delete existing chart

Sub Chart_Delete(name As String)
     On Error Resume Next
         ActiveSheet.ChartObjects(name).Delete
     On Error GoTo 0
End Sub

•  Then Main sub routine where all the functions will be called to analyze the beam

Sub Main()
   Dim Pload As Double
   Dim Dist As Double
   Dim Length As Double
   Dim x As Double
   Dim Mx As Double
   Dim Shx As Double
   Dim i As Integer
   Dim Moment() As Variant
   Dim ShearForce() As Variant
   Dim Distcoll() As Variant
   Dim mscale As Double
   Dim Reaction_A As Double
   Dim Reaction_B As Double
   Dim n As Integer
   
   '' Read input
   Pload = ActiveSheet.Range("D15")
   Dist = ActiveSheet.Range("D16")
   Length = ActiveSheet.Range("D17")
   mscale = ActiveSheet.Range("D19")
   
   ReDim Moment(CInt(Length / 0.1))
   ReDim Distcoll(CInt(Length / 0.1))
   ReDim ShearForce(CInt(Length / 0.1))
   '' Calculate the reactions
   
  Reaction_A = Reaction1_PointLoad_Cal(Pload, Dist, Length)
  Reaction_B = Reaction2_PointLoad_Cal(Pload, Dist, Length)
  
   '''Calculate the bending and shear force
  Do Until x > Length
      Mx = BendingMoment_PointLoad_Cal(Pload, x, Dist, Reaction_A)
      Shx = ShearForce_PointLoad_Cal(Pload, x, Dist, Reaction_A)
  
    Distcoll(i) = x
    Moment(i) = Mx * mscale
    ShearForce(i) = Shx * mscale
    
    i = i + 1
    x = x + 0.1
  Loop
  
  '' Draw shear force  and bending moment
  Call Chart_Add("Bending Moment")
  Call Chart_Add("Shear Force")
  
  Call Chart_Add_Data(Distcoll, Moment, "Bending Moment")
  Call Chart_Add_Data(Distcoll, ShearForce, "Shear Force")
  
  ''Output result to worksheet
  
    ActiveSheet.Range("O4 : Q1000").ClearContents
  
  For n = LBound(Distcoll) To UBound(Distcoll)
  
   ActiveSheet.Range("O" & 4 + n) = Distcoll(n)
   ActiveSheet.Range("P" & 4 + n) = Moment(n) / mscale
   ActiveSheet.Range("Q" & 4 + n) = ShearForce(n) / mscale
  
  Next n
   ActiveSheet.Range("H18").Value = Reaction_A
   ActiveSheet.Range("H19").Value = Reaction_B
   ActiveSheet.Range("i16").Value = GetMax_Moment(Moment, Distcoll)(0) / mscale
   ActiveSheet.Range("K16").Value = GetMax_Moment(Moment, Distcoll)(1)

End Sub

Download the sample file and follow the video tutorial on YouTube

The next post will be about simply supported beam subjected to uniformly distributed load.