IsnUmeric with range

[makis1023]

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)

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!

 

[Joe4]

Quite frankly, loops are notoriously slow, and should be avoided if other better options are available.
Looping through EVERY cell in a column is a very bad idea, and will probably be EXTREMELY slow.
I would HIGHLY recommend NOT doing that.

I would recommend finding the last cell with data in a certain column, and only looping that far.
For example, if you were looking at column E, I would start my loop like this:

Dim lr as Long
Dim cell as Range

'Find last row with data in column E
lr = Cells(Rows.Count,"E").End(xlUp).Row

'Loop through all populated cells in column E
For Each cell in Range("E1:E" & lr)
    ...

 

[makis1023]

Quite frankly, loops are notoriously slow, and should be avoided if other better options are available.
Looping through EVERY cell in a column is a very bad idea, and will probably be EXTREMELY slow.
I would HIGHLY recommend NOT doing that.

I would recommend finding the last cell with data in a certain column, and only looping that far.
For example, if you were looking at column E, I would start my loop like this:

Dim lr as Long
Dim cell as Range

'Find last row with data in column E
lr = Cells(Rows.Count,"E").End(xlUp).Row

'Loop through all populated cells in column E
For Each cell in Range("E1:E" & lr)
    ...

Thank you for your answer. If I want only to look for numbers, and dont take in account the other characters can I use isnumeric or something similar? Not exit the loop , just skeep text and continue to find next number.

 

[Joe4]

Yes, you should be able to use the IsNumeric function on the cell, i.e.

Dim lr as Long
Dim cell as Range

'Find last row with data in column E
lr = Cells(Rows.Count,"E").End(xlUp).Row

'Loop through all populated cells in column E
For Each cell in Range("E1:E" & lr)
    If IsNumeric(cell.Value) Then

 

[makis1023]

Yes, you should be able to use the IsNumeric function on the cell, i.e.

Dim lr as Long
Dim cell as Range

'Find last row with data in column E
lr = Cells(Rows.Count,"E").End(xlUp).Row

'Loop through all populated cells in column E
For Each cell in Range("E1:E" & lr)
    If IsNumeric(cell.Value) Then

Yes that will do the work, but how can I do that work with array ? (arry = Array(arr1, arr2, arr3, arr4)) I cant make it work.
Thank you

 

[Joe4]

Yes that will do the work, but how can I do that work with array ? (arry = Array(arr1, arr2, arr3, arr4)) I cant make it work.
Thank you

I think I would just store the column letters in an array, and then just iterate through that, i.e.
So if the values in your array were like "E, J, M, " then you could do:

Dim arr1()
Dim i As Long
Dim lr As Long
Dim c As String
Dim cell As Range

'Set initial values in array
arr1 = Array("E", "J", "M")

'Loop through array
For i = LBound(arr1) To UBound(arr1)
'   Get column value from array
    c = arr1(i)
'   Find last row in column
    lr = Cells(Rows.Count, c).End(xlUp).Row

'   Loop through each cell in column
    For Each cell In Range(Cells(1, c), Cells(lr, c))
        If IsNumeric(cell.Value) Then

 

[makis1023]

I think I would just store the column letters in an array, and then just iterate through that, i.e.
So if the values in your array were like "E, J, M, " then you could do:

Dim arr1()
Dim i As Long
Dim lr As Long
Dim c As String
Dim cell As Range

'Set initial values in array
arr1 = Array("E", "J", "M")

'Loop through array
For i = LBound(arr1) To UBound(arr1)
'   Get column value from array
    c = arr1(i)
'   Find last row in column
    lr = Cells(Rows.Count, c).End(xlUp).Row

'   Loop through each cell in column
    For Each cell In Range(Cells(1, c), Cells(lr, c))
        If IsNumeric(cell.Value) Then

I know that you like to help me, and you have done it a lot. As you can undestand I am not very good at vba but willing to learn.
About the problem I have. You see in my first code Arry is the arry = Array(arr1, arr2, arr3, arr4) where arr1,arr2 etc are ranges from different sheets. arr1 is range E:E from sheet AUDIO, arr2 is range E:E from sheet LIGHTS etc. I need to check all sheets and if somewhere in E has number (quantity in my case) then to retrieve the description, quantity and amount of that row and put in in PROFORMA INVOICE in order to make an invoice. So I need to check every sheet in the array and retrieve if any equipment has quantity etc in order to fill PROFORMA sheet. I am not from England and my English are not that good, sorry about that, so I hope I made in clear. Your last code I can understand what it does but where should I place it in my code to make it work with all sheets?
If I can I can upload the excel file in order to have an example. Can I upload it somewhere or I can ie gdrive ?

Thank you for your effort!

 

[Joe4]

I cannot say that I completely understand your method/logic on your code (not exactly sure if you have the same ranges on every sheet or what), but I don't think I would try to build my ranges like that. I think I would have two arrays, one for sheets, and one for columns, and nest my columns loop inside the sheets loop.

That being said, if it were me, if I had the choice, I probably would not go about trying to do it in this route. This seems more like a relational database structure, so I most likely would opt to use a relational database program like Microsoft Access for this sort of issue.

 

[makis1023]

I understand what you are saying, but I cant use access, or any other databased application.
I other words and be more easy to understand what I need (and I cant do) is that with the below code what I need to do.
Every Sheet will have a bunch of equipments that will have description, book and price.
Like the below

Moving Lights
Stock	Conventionall Lamp Source	Book	Daily Rate
32	Clay Paky Alpha Profile 1500 Kit (x1)
12	Clay Paky Alpha Profile 1200

The cell at all sheets will be at column D

I need to check every sheet to find out if a product have been BOOKed (and the number of booked items), collect them (with description and price) and enter the data to another sheet PROFORMA DRYHIRE. The code to do that I have it ready and working but because I will have a lot of sheets (with the same structure) there is a need to change the code. I can do arr1="D:D" and arr2="D:D" in order to check all D column but, there are also non numeric values. If it is possible I would like to check if the cell is numerical (at the range D:D) if it is proceed with the code (to check if cell >0) and go to collect values, description, price - if not numerical then just go to check next cell and continue with the script. Basic I'd like to check is cell is numerical or empty so to take it in mind and copy them to PROFORMA DRYHIRE. All these for just to avoid enter every range by hand i.e. D12:D55, D58:D90, D100:D120 etc. Check D1:D200 and thats it.

I have changed the code with

For Each cell In Sheets(ws(i)).Range(arry(i)) 'Loop through all cells in the multirange
If (IsEmpty(cell)) Then Exit For
If IsNumeric(cell.Value) Then

But it stops and doesnt check all the sheets because it exits FOR (I think because there is some empty cells...)

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 = "E20:E55, E57:E59, E73:E89, E91:E98, E100:E109"
  'cells to LIGHTS sheet
  arr2 = "E13:E34, E36:E59, E73:E89, E91:E98, E100:E109"
  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 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

I hope you understand
Thank you

 

[makis1023]

Update! This code below seems to work but I get an Error 9 Subscript out of Rance and I cant figure out why

Sub BuildInvoiceAll()
  Dim ws As Variant, arr1 As String, arr2 As String, arr3 As String, arr4 As String, arr5 As String, arr6 As String, arr7 As String, arr8 As String, arr9 As String, arr10 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("1.Power Distribution - Dimmer", "2.POWER CABLES - ADAPTORS", "3.CABLES (OTHER) - CABLE CROSS", "4.Ch. Hoist-Controllers-Cables", "5.Lighting Control - Network -W", "06.Intelligent Lighting m", "7.Conventional Lighting", "08.Misc 9.Intercom Systems", "10.Hazer - Fog - Fan")
  
  arr1 = "D1:D200"
  arr2 = "D1:D200"
  arr3 = "D1:D200"
  arr4 = "D1:D200"
  arr5 = "D1:D200"
  arr6 = "D1:D200"
  arr7 = "D1:D200"
  arr8 = "D1:D200"
  arr9 = "D1:D200"
  arr10 = "D1:D200"
  arry = Array(arr1, arr2, arr3, arr4, arr5, arr6, arr7, arr8, arr9, arr10)
  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 (IsEmpty(cell)) Then Exit For
      If IsNumeric(cell.Value) Then
        Descript = cell.Offset(0, -1)               '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

 

[Joe4]

What I am confused by is why you have different columns on different sheets.
Can we just check the SAME columns on every sheet?
If so, which columns are we to check (you mention column D in your last post, but previous posts seem to suggest column E and J)?