VBA Macros for MS Excel Sheet, which is use to calculate Perimeter, Area and Volume of Geometric shapes like Circle, Square and Rectangle.
VBA Macros program for MS Excel Sheet created, which is use to calculate Perimeter, Area and Volume of Geometric shapes like Circle, Square and Rectangle.
This program accept the input data from users like radius, length, breadth, and height values. It will process its calculation and gives a desire output.
Condition for validation:
- Should not accept character other than number or numerical
- Should not accept values other than mandatory fields (example: for circle, only radius value should be enter)
- Popup messages box wherever necessary
- Volume parameters should give an error
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 |
'************ Constants *************** Public Sub Geometry() Dim r, l, b, h, cp, ca, cv, sp, sa, sv, rp, ra, rv, hrp Dim strShp, strType Cells(12, 6).Value = "" r = Cells(7, 3).Value l = Cells(8, 3).Value b = Cells(9, 3).Value h = Cells(10, 3).Value strShp = Cells(3, 3).Value strType = Cells(4, 3).Value '***************** For Drop Down ************ If strShp = "" Then MsgBox "Geometric Shapes can't be Blank", vbCritical ElseIf strType = "" Then MsgBox "Type can't be Blank", vbCritical End If '********************For Circle ************** ' Perimeter of Circle If (strShp = "Circle" And strType = "Perimeter") Then If r = False Then MsgBox "Enter Mandatory Values: Radius", vbInformation Exit Sub ElseIf (r <= ) Then MsgBox "Entered value is less than ZERO or Negative", vbInformation Exit Sub ElseIf (IsNumeric(Cells(7, 3).Value) = False) Then MsgBox "Enter only numeric values for Radius" Exit Sub ElseIf h <> "" Or l <> "" Or b <> "" Then MsgBox "Enter only Radius" Exit Sub End If Cells(12, 6).Value = 2 * 3.14 * r ' Area of Circle ElseIf (strShp = "Circle" And strType = "Area") Then If r = False Then MsgBox "Enter Mandatory Values: Radius", vbInformation Exit Sub ElseIf r <= Then MsgBox "Entered value is not numeric or less than ZERO or Negative", vbInformation ElseIf (IsNumeric(Cells(7, 3).Value) = False) Then MsgBox "Enter only numeric values for Radius" Exit Sub ElseIf h <> "" Or l <> "" Or b <> "" Then MsgBox "Enter only Radius Field", vbInformation Exit Sub End If Cells(12, 6).Value = 3.14 * r * r ' Volume of Circle ElseIf (strShp = "Circle" And strType = "Volume") Then MsgBox "Circle does not have Volume", vbInformation End If '**************** For Square *************** 'Perimeter of Square If (strShp = "Square" And strType = "Perimeter") Then If ((l = False) And (b = False)) Then MsgBox "Enter Mandatory Values: Length or Breadth", vbInformation Exit Sub ElseIf ((l <= ) And (b <= )) Then MsgBox "Entered value is not numeric or less than ZERO or Negative", vbInformation Exit Sub ElseIf (IsNumeric(Cells(8, 3).Value) = False) Then MsgBox "Enter only numeric values for Length" Exit Sub ElseIf (IsNumeric(Cells(9, 3).Value) = False) Then MsgBox "Enter only numeric values for Breadth" Exit Sub ElseIf h <> "" Or r <> "" Then MsgBox "Enter only Length or Breadth Field", vbInformation Exit Sub End If If (l = False) And (b <> "") Then l = b End If If ((l <> "") And (b <> "") And (l <> b)) Then MsgBox "Length and Breadth of square should be same" End If Cells(12, 6).Value = 4 * l End If ' Area of Square If (strShp = "Square" And strType = "Area") Then If ((l = False) And (b = False)) Then MsgBox "Enter Mandatory Values: Length or Breadth", vbInformation Exit Sub ElseIf ((l <= ) And (b <= )) Then MsgBox "Entered value is not numeric or less than ZERO or Negative", vbInformation Exit Sub ElseIf (IsNumeric(Cells(8, 3).Value) = False) Then MsgBox "Enter only numeric values for Length" Exit Sub ElseIf (IsNumeric(Cells(9, 3).Value) = False) Then MsgBox "Enter only numeric values for Breadth" Exit Sub ElseIf h <> "" Or r <> "" Then MsgBox "Enter only Length or Breadth Field", vbInformation Exit Sub End If If (l = False) And (b <> "") Then l = b End If If ((l <> "") And (b <> "") And (l <> b)) Then MsgBox "Length and Breadth of square should be same" End If Cells(12, 6).Value = l * l End If ' Volume of Square If (strShp = "Square" And strType = "Volume") Then MsgBox "Square does not have Volume", vbInformation End If '**************** For Rectangle****************** ' Perimeter of Rectangle If (strShp = "Rectangle" And strType = "Perimeter") Then If (l = False Or b = False) Then MsgBox "Enter Mandatory Values: Length and Breadth", vbInformation Exit Sub ElseIf ((l <= ) Or (b <= )) Then MsgBox "Entered value is not numeric or less than ZERO or Negative", vbInformation Exit Sub ElseIf (IsNumeric(Cells(8, 3).Value) = False) Then MsgBox "Enter only numeric values for Length" Exit Sub ElseIf (IsNumeric(Cells(9, 3).Value) = False) Then MsgBox "Enter only numeric values for Breadth" Exit Sub ElseIf h <> "" Or r <> "" Then MsgBox "Enter only Length and Breadth", vbInformation Exit Sub ElseIf l = b Then MsgBox "Rectangle cannot have same Length and Breadth", vbInformation Exit Sub End If Cells(12, 6).Value = 2 * (l + b) End If 'Area of Rectangle If (strShp = "Rectangle" And strType = "Area") Then If (l = False Or b = False) Then MsgBox "Enter Mandatory Values: Length and Breadth", vbInformation Exit Sub ElseIf ((l <= ) Or (b <= )) Then MsgBox "Entered value is not numeric or less than ZERO or Negative", vbInformation Exit Sub ElseIf (IsNumeric(Cells(8, 3).Value) = False) Then MsgBox "Enter only numeric values for Length" Exit Sub ElseIf (IsNumeric(Cells(9, 3).Value) = False) Then MsgBox "Enter only numeric values for Breadth" Exit Sub ElseIf h <> "" Or r <> "" Then MsgBox "Enter only Length and Breadth", vbInformation Exit Sub ElseIf l = b Then MsgBox "Rectangle cannot have same Length and Breadth", vbInformation Exit Sub End If Cells(12, 6).Value = l * b End If 'Volume of Rectangle If (strShp = "Rectangle" And strType = "Volume") Then MsgBox "Rectangle does not have volume", vbInformation End If End Sub '****************** End of Program *****************8 |
Download File:
Special conditions for Square shape:
- Square should accept length or breadth
- If both enter, Length and breadth should be same
Special conditions for Rectangle shape:
- Rectangle should have different length and breadth size
- If same, it should popup a message saying “Length and Breadth of rectangle cannot be same.
If you need any more modification, changes or addition of function, kindly comment below.
