Copy entire row if cell is not empty - VBA

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
Hello,

There is a need to copy contents from a sheet if the value of a specific cell is NOT 0 or it is blank.
Need to copy the entire row and its contents to another sheet. Basically need to create rows in target sheet and not overwriten them.
Lets say that the source sheet is AUDIO and the target is TEST1. The value that needed to check is range B13:B25
Can this be done with multiple source sheets and multiple source ranges? All will copied to the same target sheet.

I have found some posts in mrexcel but I cant make them to work properly (maybe multiple criteria are wrong)

Can you help?

Thank you in advance!
 

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
This should work. It may need some minor modifications, based on the structure of your data sheets (I assumed your data is in columns B-E in rows 13:25, as your original code was looking in E13:E25).
VBA Code:
Sub BuildInvoice()

    Dim ws
    Dim i As Long
    Dim cell As Range
    Dim Descript As String
    Dim PPD As Double
    Dim PCS As Long
    Dim nr As Long
   
    Application.ScreenUpdating = False
   
'   Set array of worksheet names to copy from
    ws = Array("AUDIO", "LIGHTS")
   
    For i = LBound(ws) To UBound(ws)
'       Iterate through column D on each sheet looking for pieces
        For Each cell In Sheets(ws(i)).Range("E13:E25")
'           See if anything entered in pieces
            If cell > 0 Then
                Descript = cell.Offset(0, -3)  'get description from column B
                PPD = cell.Offset(0, -1) 'get price p/d from column D
                PCS = cell  'get pieces from column E
'               Find next available row in column A on Invoice sheet
                nr = Sheets("Invoice").Cells(Rows.Count, "A").End(xlUp).Row + 1
'               Populate values on Invoice sheet
                Sheets("Invoice").Cells(nr, "A") = Descript
                Sheets("Invoice").Cells(nr, "B") = PCS
                Sheets("Invoice").Cells(nr, "C") = PPD
            End If
        Next cell
    Next i
   
    Application.ScreenUpdating = False
   
    MsgBox "Invoice built!"
       
End Sub
wow! super fast ! I will try it and let you know!
Thank you very very much!
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,499
Office Version
  1. 365
Platform
  1. Windows
You are welcome.
 

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
You are welcome.
Hello again,

It works fine! Thank you!
Something more is I can ask, is it possible to start creating invoice from row A15 , as from A1 to A14 there are logos etc
About the source range, is it possible to be "E13:E25", "F13:F25" etc to have more than one source range? For more Sheets I understand that I have to insert them to ws = Array , is this correct?

The target is the same.

Thank you!
 
Last edited:

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
@Joe4 Can I use that ?

' Dim r1 As Range, r2 As Range, myMultiAreaRange As Range
' Set r1 = Range("E13:E25")
' Set r2 = Range("E49:E71")
' Set myMultiAreaRange = Union(r1, r2)
' myMultiAreaRange.Select

and put myMultiAreaRang and not Range ?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,499
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Something more is I can ask, is it possible to start creating invoice from row A15 , as from A1 to A14 there are logos etc
You can add this a new row after this section:
VBA Code:
'               Find next available row in column A on Invoice sheet
                nr = Sheets("Invoice").Cells(Rows.Count, "A").End(xlUp).Row + 1
that looks like this:
VBA Code:
If nr < 15 Then nr = 15

Regarding your question on your ranges, I think that should work.
Easiest way to find out is to try it and see if it works!
 

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
You can add this a new row after this section:
VBA Code:
'               Find next available row in column A on Invoice sheet
                nr = Sheets("Invoice").Cells(Rows.Count, "A").End(xlUp).Row + 1
that looks like this:
VBA Code:
If nr < 15 Then nr = 15

Regarding your question on your ranges, I think that should work.
Easiest way to find out is to try it and see if it works!
I did the nr < 15, first doesnt working ... then I realised that there where merged cells! so unmerge and voila! worked just fine ! Thank you once again!
About the range I will try and if stuck somewhere I will let you know.
About the sheets if I put 4 sheets to check there is an error
The code is

VBA Code:
ws = Array("AUDIO", "LIGHTS", "DCM")
and if I insert more, crashed
Three sheets are the max?

Thank you !!!
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,499
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I did the nr < 15, first doesnt working ... then I realised that there where merged cells! so unmerge and voila! worked just fine
Yes, merged cells are VERY problematic for things like VBA and other simple tasks (like sorting). I highly recommend never using them.
If just merging cells across single rows, you can usually accomplish the same visual effects without all the issues that merged cells cause by using the "Center Across Selection" formatting option instead. See: Tom’s Tutorials For Excel: Using Center Across Selection Instead of Merging Cells – Tom Urtis

About the sheets if I put 4 sheets to check there is an error
The code is

VBA Code:
ws = Array("AUDIO", "LIGHTS", "DCM")
and if I insert more, crashed
Three sheets are the max?
No, I have done a lot more than 3 or 4 sheets before without issues. If you are getting an error, it may be do to something else (the strucuture of one of your sheets, or the data in one of the sheets).
Try just doing one or two sheets in a test, including the one that is causing the error. And make note of which line of code is causing the error (hit the "Debug" button, if that option exists, and see which line of code it highlights).

Note, if you have a whole bunch of sheets in your workbook, and you only want to skip one or two, instead of storing all the different sheet names in an array, you can simply loop through all sheets, and skip if the sheet is a particular name, i.e.
VBA Code:
For Each ws in Worksheets
    If ws.Name = "Invoice1" or ws.Name = "Invoce2" Then
'      do nothing
    Else
'       your main code here
    End If
Next ws
So that structure above would ignore any sheet named "Invoice1" or "Invoice2", and process all the others.

Next ws
 

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
Yes, merged cells are VERY problematic for things like VBA and other simple tasks (like sorting). I highly recommend never using them.
If just merging cells across single rows, you can usually accomplish the same visual effects without all the issues that merged cells cause by using the "Center Across Selection" formatting option instead. See: Tom’s Tutorials For Excel: Using Center Across Selection Instead of Merging Cells – Tom Urtis


No, I have done a lot more than 3 or 4 sheets before without issues. If you are getting an error, it may be do to something else (the strucuture of one of your sheets, or the data in one of the sheets).
Try just doing one or two sheets in a test, including the one that is causing the error. And make note of which line of code is causing the error (hit the "Debug" button, if that option exists, and see which line of code it highlights).

Note, if you have a whole bunch of sheets in your workbook, and you only want to skip one or two, instead of storing all the different sheet names in an array, you can simply loop through all sheets, and skip if the sheet is a particular name, i.e.
VBA Code:
For Each ws in Worksheets
    If ws.Name = "Invoice1" or ws.Name = "Invoce2" Then
'      do nothing
    Else
'       your main code here
    End If
Next ws
So that structure above would ignore any sheet named "Invoice1" or "Invoice2", and process all the others.

Next ws
Yes, I made it work ! Excel was a mess ... so I fix formatings and everything ok.
Now, I will try Range!
I only have 4 sheets, so its ok! thanks
 

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
88
Range, first error
VBA Code:
Sub BuildInvoice()


    Dim ws
    Dim i As Long
    Dim cell As Range
    Dim Descript As String
    Dim PPD As Double
    Dim PCS As Long
    Dim nr As Long
    Dim r1 As Range, r2 As Range, myMultiAreaRange As Range
    
    Application.ScreenUpdating = False
   
'   ' Set array of worksheet names to copy from
    ws = Array("AUDIO", "LIGHTS", "DCM", "HTD")
    Set r1 = Range("E13:E25")
    Set r2 = Range("E33:E39")
    Set myMultiAreaRange = Union(r1, r2)
    'myMultiAreaRange.Select
   
    For i = LBound(ws) To UBound(ws)
'       Iterate through column D on each sheet looking for pieces
        For Each cell In Sheets(ws(i)).myMultiAreaRange
'           See if anything entered in pieces
            If cell > 0 Then
                Descript = cell.Offset(0, -3)  'get description from column B
                PPD = cell.Offset(0, -1) 'get price p/d from column D
                PCS = cell  'get pieces from column E
'               Find next available row in column A on Invoice sheet
                nr = Sheets("PROFORMA").Cells(Rows.Count, "A").End(xlUp).Row + 1
                If nr < 15 Then nr = 15
'               Populate values on Invoice sheet
                Sheets("PROFORMA").Cells(nr, "A") = Descript
                Sheets("PROFORMA").Cells(nr, "B") = PCS
                Sheets("PROFORMA").Cells(nr, "C") = PPD
            End If
        Next cell
    Next i
   
    Application.ScreenUpdating = False
   
    MsgBox "Invoice built!"
       
End Sub

?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,499
Office Version
  1. 365
Platform
  1. Windows
You don't want to build your range until you are inside the loop, so that they will apply to each sheet.
If you build them outside of the loop, they will just be applied to whatever the active sheet was when you started running the code (and will not change at all after that).
And you need to include the worksheet reference when building the initial ranges.

So, try something like this:
VBA Code:
Sub BuildInvoice()


    Dim ws
    Dim i As Long
    Dim cell As Range
    Dim Descript As String
    Dim PPD As Double
    Dim PCS As Long
    Dim nr As Long
    Dim r1 As Range, r2 As Range, myMultiAreaRange As Range
    
    Application.ScreenUpdating = False
   
'   ' Set array of worksheet names to copy from
    ws = Array("AUDIO", "LIGHTS", "DCM", "HTD")
   
'   Loop through all shees inthe array
    For i = LBound(ws) To UBound(ws)
        Set r1 = Sheets(ws(i)).Range("E13:E25")
        Set r2 = Sheets(ws(i)).Range("E33:E39")
        Set myMultiAreaRange = Union(r1, r2)
'       Iterate through column D on each sheet looking for pieces
        For Each cell In Sheets(ws(i)).myMultiAreaRange
'           See if anything entered in pieces
            If cell > 0 Then
                Descript = cell.Offset(0, -3)  'get description from column B
                PPD = cell.Offset(0, -1) 'get price p/d from column D
                PCS = cell  'get pieces from column E
'               Find next available row in column A on Invoice sheet
                nr = Sheets("PROFORMA").Cells(Rows.Count, "A").End(xlUp).Row + 1
                If nr < 15 Then nr = 15
'               Populate values on Invoice sheet
                Sheets("PROFORMA").Cells(nr, "A") = Descript
                Sheets("PROFORMA").Cells(nr, "B") = PCS
                Sheets("PROFORMA").Cells(nr, "C") = PPD
            End If
        Next cell
    Next i
   
    Application.ScreenUpdating = False
   
    MsgBox "Invoice built!"
       
End Sub
 

Forum statistics

Threads
1,144,281
Messages
5,723,473
Members
422,499
Latest member
think say

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top