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!

 

[makis1023]

Yes you are absolutely right. I changed the template of sheets to only have column D
Yes, D is the correct one.

 

[Joe4]

Can you clarify one other thing for me?
When you find a row that you want to copy over to your "PROFORMA DRYHIRE" sheet, what columns are you copying over? Is it always the same?
So, will you always be copying over columns B,C,D to column A,B,C?

 

[makis1023]

Of course

An example of the template I need to retrieve data from is

MENELAOS-UTG-PROFORMA-TESTING2.xlsm
	A	B	C	D	E	F
1		Stock	DESCRIPT	PIECES	PRICE
2		32	Clay Paky Alpha Profile 1500 Kit (x1)
3		12	Clay Paky Alpha Profile 1200
4		32	Clay Paky Alpha Spot HPE 1500 Kit (x1)
5		100	Clay Paky Alpha Wash 1200
1

And check column D

So if D is not empty and is numeric then retrieve data from C (descript) D (pieces) and E (price) and enter them at PROFORMA DRYHIRE

MENELAOS-UTG-PROFORMA-TESTING2.xlsm
	A	B	C
1	DESCRIPT	PIECES	PRICE
2
3
4
5
6
7
8
9
PROFORMA DRYHIRE

C (checked sheet) will be A at PROFORMA DRYHIRE
D (checked sheet) will be B at PROFORMA DRYHIRE
E (checked sheet) will BE C at PROFORMA DRYHIRE


Yes will always be copied at the same columns at PROFORMA DRYHIRE in order to make the sum of Pieces, Price etc

Thank you again

 

[Joe4]

OK, here is the version I would use to do what you need:

Sub BuildInvoiceAll()

    Dim ws As Variant, sht As Variant, arry As Variant
    Dim i As Long, lr As Long, nr As Long, c As Long
    Dim cell As Range
    
    Application.ScreenUpdating = False
  
'   Set array of worksheet names to copy from
    ws = Array("AUDIO", "LIGHTS", "HOISTS - TRUSS - DRAPES", "DISTRO - CABLES - MISC")
  
'   Array of columns to check
    sht = Array("D")

    nr = 15
    Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents
   
'   Loop through all sheets in sheets array
    For i = LBound(ws) To UBound(ws)
'       Loop through all columns in the column array
        For c = LBound(sht) To UBound(sht)
'           Find last row in column with data
            Sheets(ws(i)).Activate
            lr = Cells(Rows.Count, sht(c)).End(xlUp).Row
'           Loop through all cells in column
            For Each cell In Range(Cells(1, sht(c)), Cells(lr, sht(c)))
'               Check to see if value is numeric and not 0
                If (IsNumeric(cell.Value)) And (cell.Value <> 0) Then
'                   Copy cells C, D, E to columns A, B, C of main sheet
                    Range(Cells(cell.Row, "C"), Cells(cell.Row, "E")).Copy Sheets("PROFORMA DRYHIRE").Cells(nr, "A")
'                   Increment nr counter
                    nr = nr + 1
'                   Check to see if rows are full
                    If nr > 70 Then
                        MsgBox "Rows are full"
                        Exit Sub
                    End If
                End If
            Next cell
        Next c
    Next i

  Application.ScreenUpdating = False
  
  MsgBox "Macro complete!"

End Sub

 

[makis1023]

Ahh... I Really dont know what is the problem!
If you can please check the Google Drive link , to figure out what is wrong. I did all the steps

TEST

Thank you !

 

[Joe4]

Ahh... I Really dont know what is the problem!
If you can please check the Google Drive link , to figure out what is wrong. I did all the steps

TEST

Thank you !

I cannot download your file from my current location.

How is it not working?
What exactly is it doing wrong?

Did you copy and paste my code, exactly as-is (instead of trying to type it manually)?
This will ensure that you did not make any typos or miss anything.

Also, what is the name of the module that you have placed this code in.

 

[Fluff]

You need to put the code in a standard module NOT as sheet module.

 

[makis1023]

Yes! Thats it the catch!

 

[makis1023]

What is the difference if I put the code in sheet module and not standard module?

 

[makis1023]

I cannot download your file from my current location.

How is it not working?
What exactly is it doing wrong?

Did you copy and paste my code, exactly as-is (instead of trying to type it manually)?
This will ensure that you did not make any typos or miss anything.

Also, what is the name of the module that you have placed this code in.

The issue was , that it was searching for sheet that they dont exist! So return error. But it is working fine and Thank you very much for the effort!!!