check if isnumeric data in two different cell in vba

[mehidy1437]

Hi
How can I check, if cell a1 or cell b1 contain numerics data/value or not in vba?

 

[Rick Rothstein]

Hi Rick, it is certainly another way to write the macro, but it does not solve the initial OP question "check if isnumeric data in two different cell in vba".
If the cells are not numeric, your macro sends an error: "Type Mismatch"

Arghhh!!!!! I forgot the On Error trap!

Sub CalculationOnSelctionRng_4()
  Dim X As Long, ArrSymbols As Variant, ArrWords As Variant
  ArrSymbols = Array(, , "-", "*", "/", "+")
  ArrWords = Array("Cell:" & vbTab & Selection.Address(0, 0), "", "Subtract:", "Multiply:", "Divide:", "Sum:")
  On Error GoTo NotAllNumbers
  For X = LBound(ArrSymbols) + 2 To UBound(ArrSymbols)
    ArrWords(X) = ArrWords(X) & vbTab & Evaluate(Replace(Selection.Address(0, 0), ":", ArrSymbols(X)))
  Next
  MsgBox Join(ArrWords, vbLf)
  Exit Sub
NotAllNumbers:
  MsgBox "The values in your SELECTION are not all numbers or the last cell is a zero.", vbCritical
End Sub

 

[DanteAmor]

It is true, to avoid the error of div/0, the validation of the last cell <> 0 is missing.
Updated macro:

Sub CalculationOnSelctionRng_2()
  Dim Rng As Range, fCell As Variant, lCell As Variant
  Set Rng = Selection
  fCell = Rng.Cells(1).Value
  lCell = Rng(Rng.Count).Value
  If IsNumeric(fCell) And IsNumeric(lCell) And lCell <> 0 Then
    MsgBox "Cell    " & vbTab & "= " & Rng.Address(0, 0) & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & fCell - lCell & vbCr & _
           "Multiple" & vbTab & "= " & fCell * lCell & vbCr & _
           "Divide  " & vbTab & "= " & fCell / lCell & vbCr & _
           "Sum     " & vbTab & "= " & fCell + lCell & vbCr
  Else
    MsgBox "The values in SELECTION is not number or the last cell is equal to 0"
  End If
End Sub

 

[mehidy1437]

Many thanks to both of you for great help.

I have just added some more arguments to do the calculations in both way based on active cell.
Here below the code & its working fine. Thanks again.

Sub CalculationOnSelctionRng_2()
  Dim Rng As Range, fCell As Variant, lCell As Variant, ACellAdd As String, lCellAdd As String, NoOfCell As Integer
  Set Rng = Selection
  fCell = Rng.Cells(1).Value
  lCell = Rng(Rng.count).Value
  ACellAdd = ActiveCell.Address(0, 0)
  lCellAdd = Rng(Rng.count).Address(0, 0)
   NoOfCell = Range(Rng.Address).count
  If IsNumeric(fCell) And IsNumeric(lCell) And lCell <> 0 Then
  If ACellAdd = lCellAdd Then
 
  MsgBox "Cell    " & vbTab & "= " & Rng.Address(0, 0) & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & lCell - fCell & vbCr & _
           "Multiple" & vbTab & "= " & lCell * fCell & vbCr & _
           "Divide  " & vbTab & "= " & lCell / fCell & vbCr & _
           "Sum     " & vbTab & "= " & lCell + fCell & vbCr
 
  Else
 
    MsgBox "Cell    " & vbTab & "= " & Rng.Address(0, 0) & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & fCell - lCell & vbCr & _
           "Multiple" & vbTab & "= " & fCell * lCell & vbCr & _
           "Divide  " & vbTab & "= " & fCell / lCell & vbCr & _
           "Sum     " & vbTab & "= " & fCell + lCell & vbCr
  End If

  Else
    MsgBox "The values in SELECTION is not number or the last cell is equal to 0"
  End If
End Sub

 

[DanteAmor]

Youre welcome.
I don't understand why you compare the address of the first cell with the address of the last cell.
If the 2 cells are the same it is the same as putting fCell / lCell or lCell / fCell.

It is not necessary to put the condition If ACellAdd = lCellAdd

Or maybe you are looking for another comparison, if you explain what you need we can find a solution.

 

[mehidy1437]

Youre welcome. I don't understand why you compare the address of the first cell with the address of the last cell. If the 2 cells are the same it is the same as putting fCell / lCell or lCell / fCell. It is not necessary to put the condition If ACellAdd = lCellAdd Or maybe you are looking for another comparison, if you explain what you need we can find a solution.

I'm using this argument/condition (If ACellAdd = lCellAdd ) to get the different result based on my active cell position. Here below a snap for your ref.

 

[DanteAmor]

I agree. Let me know if you need anything else and I will gladly support you.

 

[mehidy1437]

I agree. Let me know if you need anything else and I will gladly support you.

Hi, Many thanks for you support.
Here below is the final result for 4 way calculation, based on active cell positions in a range.
Hope its okay in all aspects. Awaiting for your comments on it.

  Option Explicit

Sub CalculationOnSelctionRng()
   On Error GoTo Last

   Dim Rng As Range, sArea As Variant, fCell As Variant, lCell As Variant, ACellAdd As String, fCellAdd As String, lCellAdd As String, NoOfCell As Integer
   Dim CRightUp As Variant, CLeftDown As Variant, CRightUpAdd As Variant, CLeftDownAdd As Variant
  
  Set Rng = Selection
  sArea = Rng.Address(0, 0)
  fCell = Rng.Cells(1).Value
  lCell = Rng(Rng.count).Value
  ACellAdd = ActiveCell.Address(0, 0)
  fCellAdd = Rng.Cells(1).Address(0, 0)
  lCellAdd = Rng(Rng.count).Address(0, 0)
  NoOfCell = Range(Rng.Address).count
 
  CRightUp = Rng.Cells(1, Rng.Columns.count)
  CLeftDown = Rng.Cells(Rng.Rows.count, 1)
  CRightUpAdd = Rng.Cells(1, Rng.Columns.count).Address(0, 0)
  CLeftDownAdd = Rng.Cells(Rng.Rows.count, 1).Address(0, 0)
 
  If ACellAdd = lCellAdd And IsNumeric(fCell) And IsNumeric(lCell) And fCell <> 0 And lCell <> 0 Then
 
  MsgBox "Range    " & vbTab & "= " & sArea & vbCr & _
          "Cells" & vbTab & "= " & lCellAdd & " & " & fCellAdd & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & lCell - fCell & vbCr & _
           "Multiple" & vbTab & "= " & lCell * fCell & vbCr & _
           "Divide  " & vbTab & "= " & lCell / fCell & vbCr & _
           "Sum     " & vbTab & "= " & lCell + fCell & vbCr
 
  ElseIf ACellAdd = fCellAdd And IsNumeric(fCell) And IsNumeric(lCell) And fCell <> 0 And lCell <> 0 Then
 
 
    MsgBox "Range    " & vbTab & "= " & sArea & vbCr & _
           "Cells" & vbTab & "= " & fCellAdd & " & " & lCellAdd & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & fCell - lCell & vbCr & _
           "Multiple" & vbTab & "= " & fCell * lCell & vbCr & _
           "Divide  " & vbTab & "= " & fCell / lCell & vbCr & _
           "Sum     " & vbTab & "= " & fCell + lCell & vbCr
  
   ElseIf ACellAdd = CLeftDownAdd And IsNumeric(CLeftDown) And IsNumeric(CRightUp) And CLeftDown <> 0 And CRightUp <> 0 Then
 
    MsgBox "Range    " & vbTab & "= " & sArea & vbCr & _
           "Cells" & vbTab & "= " & CLeftDownAdd & " & " & CRightUpAdd & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & CLeftDown - CRightUp & vbCr & _
           "Multiple" & vbTab & "= " & CLeftDown * CRightUp & vbCr & _
           "Divide  " & vbTab & "= " & CLeftDown / CRightUp & vbCr & _
           "Sum     " & vbTab & "= " & CLeftDown + CRightUp & vbCr
          
    ElseIf ACellAdd = CRightUpAdd And IsNumeric(CLeftDown) And IsNumeric(CRightUp) And CLeftDown <> 0 And CRightUp <> 0 Then
 
    MsgBox "Range    " & vbTab & "= " & sArea & vbCr & _
           "Cells" & vbTab & "= " & CRightUpAdd & " & " & CLeftDownAdd & vbCr & vbCr & _
           "Subtract" & vbTab & "= " & CRightUp - CLeftDown & vbCr & _
           "Multiple" & vbTab & "= " & CRightUp * CLeftDown & vbCr & _
           "Divide  " & vbTab & "= " & CRightUp / CLeftDown & vbCr & _
           "Sum     " & vbTab & "= " & CRightUp + CLeftDown & vbCr
 
  Else
    MsgBox "The values in SELECTION is not number or the last cell is equal to 0"
  End If
Last: Exit Sub
    
End Sub

 

[DanteAmor]

Thank you for sharing your macro, I'm glad to know that it works for you. :D