IsNumeric with range

Hello all,

I have the following code that works great. Because it will be big enough I want to choose only the numbers from E or J etc and not have to make choise (ie E34:E66. J15:J33)

VBA Code:

Sub BuildInvoiceAll()  Dim ws As Variant, arr1 As String, arr2 As String, arr3 As String, arr4 As String, arry As Variant  Dim i As Long, j As Long, nr As Long  Dim cell As Range, f As Range  Dim Descript As String      Application.ScreenUpdating = False  'Set array of worksheet names to copy from  ws = Array("AUDIO", "LIGHTS", "HOISTS - TRUSS - DRAPES", "DISTRO - CABLES - MISC")    'cells to AUDIO sheet  arr1 = "E:E, J:J"  'cells to LIGHTS sheet  arr2 = "E13:E34, J13:J59, E36:E59, E73:E89, J73:J82, J84:J91, E91:E98, J93:J101, E100:E109, J103:J113"  'cells to HOISTS sheet  arr3 = "E13:E28, K13:K37, E30:E40, E42:E52, E67:E91, K67:K85, E106:E123, K106:K119, K121:K129, E127:E137"  'cells to DISTRO sheet  arr4 = "E13:E35, K13:K50, E37:E50, E64:E116, K64:K88, K92:K108, K111:K120, E131:E148, K131:K148, K150:K159," & _         "E152:E180 , K163:K188 , K190:K203 , E184:E216 , K207:K238 , K240:K249 "  arry = Array(arr1, arr2, arr3, arr4)  nr = 14  Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents   For i = LBound(ws) To UBound(ws)                  'Loop through all shees in the array    For Each cell In Sheets(ws(i)).Range(arry(i))   'Loop through all cells in the multirange      If cell > 0 Then                               'See if anything entered in pieces        Descript = cell.Offset(0, -3)               'get description from column B        With Sheets("PROFORMA DRYHIRE")          Set f = .Range("A15:A70").Find(Descript, , xlValues, xlWhole)          If Not f Is Nothing Then            nr = f.Row          Else            nr = nr + 1            If nr > 70 Then              MsgBox "Rows are full"              Exit Sub            End If          End If                  .Cells(nr, "A") = Descript                'Populate values in PROFORMA sheet          .Cells(nr, "B") = cell                    'get pieces from column E          .Cells(nr, "C") = cell.Offset(0, -1)      'get price p/d from column D        End With      End If    Next cell  Next i  Application.ScreenUpdating = False
End Sub

Can this be done?

Thank you!

Note! This is also posted on mrexcel Forum https://www.mrexcel.com/board/…meric-with-range.1196052/

Quote from pantakos

Hello all,

I have the following code that works great. Because it will be big enough I want to choose only the numbers from E or J etc and not have to make choise (ie E34:E66. J15:J33)

VBA Code:

Code

Sub BuildInvoiceAll()  Dim ws As Variant, arr1 As String, arr2 As String, arr3 As String, arr4 As String, arry As Variant  Dim i As Long, j As Long, nr As Long  Dim cell As Range, f As Range  Dim Descript As String      Application.ScreenUpdating = False  'Set array of worksheet names to copy from  ws = Array("AUDIO", "LIGHTS", "HOISTS - TRUSS - DRAPES", "DISTRO - CABLES - MISC")    'cells to AUDIO sheet  arr1 = "E:E, J:J"  'cells to LIGHTS sheet  arr2 = "E13:E34, J13:J59, E36:E59, E73:E89, J73:J82, J84:J91, E91:E98, J93:J101, E100:E109, J103:J113"  'cells to HOISTS sheet  arr3 = "E13:E28, K13:K37, E30:E40, E42:E52, E67:E91, K67:K85, E106:E123, K106:K119, K121:K129, E127:E137"  'cells to DISTRO sheet  arr4 = "E13:E35, K13:K50, E37:E50, E64:E116, K64:K88, K92:K108, K111:K120, E131:E148, K131:K148, K150:K159," & _         "E152:E180 , K163:K188 , K190:K203 , E184:E216 , K207:K238 , K240:K249 "  arry = Array(arr1, arr2, arr3, arr4)  nr = 14  Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents   For i = LBound(ws) To UBound(ws)                  'Loop through all shees in the array    For Each cell In Sheets(ws(i)).Range(arry(i))   'Loop through all cells in the multirange      If cell > 0 Then                               'See if anything entered in pieces        Descript = cell.Offset(0, -3)               'get description from column B        With Sheets("PROFORMA DRYHIRE")          Set f = .Range("A15:A70").Find(Descript, , xlValues, xlWhole)          If Not f Is Nothing Then            nr = f.Row          Else            nr = nr + 1            If nr > 70 Then              MsgBox "Rows are full"              Exit Sub            End If          End If                  .Cells(nr, "A") = Descript                'Populate values in PROFORMA sheet          .Cells(nr, "B") = cell                    'get pieces from column E          .Cells(nr, "C") = cell.Offset(0, -1)      'get price p/d from column D        End With      End If    Next cell  Next i  Application.ScreenUpdating = False
End Sub

Can this be done?

Thank you!

Note! This is also posted on mrexcel Forum https://www.mrexcel.com/board/…meric-with-range.1196052/

Display More

Also posted at https://stackoverflow.com/ques…5605/isnumeric-with-range

Sub BuildInvoiceAll()
  Dim ws As Variant, arr1 As String, arr2 As String, arr3 As String, arr4 As String, arry As Variant
  Dim i As Long, j As Long, nr As Long
  Dim cell As Range, f As Range
  Dim Descript As String
  Dim all_numeric As Boolean
  all_numeric = True
    
  Application.ScreenUpdating = False
  'Set array of worksheet names to copy from
  ws = Array("AUDIO", "LIGHTS")
  
  'cells to AUDIO sheet
  arr1 = "E:E, J:J"
  'cells to LIGHTS sheet
  arr2 = "E:E, J:J"
  'cells to HOISTS sheet
  'arr3 = "E:E, K:K"
  'cells to DISTRO sheet
  'arr4 = "E:E, K:K"
  arry = Array(arr1, arr2)
  nr = 14
  Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents
  For i = LBound(ws) To UBound(ws)                  'Loop through all shees in the array
    For Each cell In Sheets(ws(i)).Range(arry(i))   'Loop through all cells in the multirange
    If Not IsNumeric(cell) Then 
        all_numeric = False
        Exit For
    End If
Next cell
For Each cell In Sheets(ws(i)).Range(arry(i))
      If cell > 0 Then                              'See if anything entered in pieces
        Descript = cell.Offset(0, -3)               'get description from column B
        With Sheets("PROFORMA DRYHIRE")
          Set f = .Range("A15:A70").Find(Descript, , xlValues, xlWhole)
          If Not f Is Nothing Then
            nr = f.Row
          Else
            nr = nr + 1
            If nr > 70 Then
              MsgBox "Rows are full"
              Exit Sub
            End If
          End If
          .Cells(nr, "A") = Descript                'Populate values in PROFORMA sheet
          .Cells(nr, "B") = cell                    'get pieces from column E
          .Cells(nr, "C") = cell.Offset(0, -1)      'get price p/d from column D
        End With
      End If
    Next cell
  Next i
  Application.ScreenUpdating = False
End Sub

Hello RoyUK. Thank you for your answer and effort. What I am trying to do is not to enter all the ranges i.e. E2:E45, K3:K88 etc but instead this to just enter K:K, E:E to check all the column. And furthermore, into E column there is text, and because I only need numeric values to do mathematical equation, I need to choose only numeric. I hope you understand. Thank you