Copy Row If Cell Range Are Not Blank

By | February 12, 2018
Questions:

I wonder whether someone may be able to help me please.

I have an Excel (2003) spreadsheet called ‘Input’ with data in columns B to N. What I would like to be able to do is if there is text in any of the cells in column B, I would like to copy the row but only columns ‘B’ ‘I’ and ‘N’ and paste them into my second spreadsheet called ‘Output’ at cell ref B2.

If at all possible, once the information has been pasted, I’d like to add the word ‘Scheduled site’ in column ‘E’ on the ‘Output’ sheet if the cells in column ‘B’ have text in them.

I’ve been doing this manually, and it takes quite some time to do.

I just wondered whether someone may be able to show me please how I can automate this.

Many thanks

Answers:

if your data looks like below, and you text entries are not formulae, then this approach will be very fast as it exploits SpecialCells to avoid looping rows

Sub MoveEM2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets("Input")
Set ws2 = Sheets("Output")
On Error Resume Next
Set rng1 = ws1.Columns("B").SpecialCells(xlConstants)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set rng2 = ws2.[b2]
rng1.Copy rng2
'copy column I to Output C2
rng1.Offset(0, 7).Copy rng2.Offset(0, 1)
'copy column N to Output d2
rng1.Offset(0, 12).Copy rng2.Offset(0, 2)
rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site"
Application.ScreenUpdating = True
End Sub

enter image description here

[updated for further query]

Sub MoveEM()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Set ws1 = Sheets("Input")
    Set ws2 = Sheets("Output")
    On Error Resume Next
    Set rng1 = ws1.Range(ws1.[b4], ws1.Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlConstants)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set rng2 = ws2.[b2]
    rng1.Copy
    rng2.PasteSpecial xlPasteValues
    'copy column I to Output C2
    rng1.Offset(0, 7).Copy
    rng2.Offset(0, 1).PasteSpecial xlPasteValues
    'copy column N to Output d2
    rng1.Offset(0, 12).Copy
    rng2.Offset(0, 2).PasteSpecial xlPasteValues
    rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site"
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Questions:
Answers:

I was looking to do the same in a Google Docs spreadsheet so macros were out, I managed to do it with some IFs and VLOOKUPs. It seems a bit convoluted, maybe someone has a more effective way to do this, but this should work without macros:

To the left of the input, I created a column starting with 0 and incrementing every time column B has data in it:

A1=0
A2=IF(ISBLANK(B2),A1,A1+1)
A3=IF(ISBLANK(B3),A2,A2+1)
...

so the first sheet looks like this:

0    
1    data1
1
2    data2
3    data3
3    
3
4    data4

Then on the output sheet, have a column with simply incrementing values and do a vlookup for the first row containing that number:

A1=1
A2=2
...

and

B1=VLOOKUP(A1,Sheet1!A:B,2,FALSE)
B2=VLOOKUP(A2,Sheet1!A:B,2,FALSE)
...

So the second sheet looks like this:

1    data1
2    data2
3    data3
4    data4

Do another vlookup for any other columns you want to transfer from the first sheet, then hide the columns with the numbers in them.

Questions:
Answers:

IRHM,

Just in case, you know how to handle this here is an example. Remember, everyone does things differently, so this is probably not the fastest or most elegant way.

Sub MoveData()
    Sheets("Output").Select
    'Select the input sheet
    OutputRowCounter = Range("A65536").End(xlUp).Row + 1 
     'find the last used row in column A of the output sheet
    Sheets("Input").Select 'Select the input sheet
    InputMaxRow = Range("A65536").End(xlUp).Row 'find the last used row in column A of the input sheet

    For rowLoop = 2 To InputMaxRow 'loop through the file and copy data from columns B-N to output A-M
        If Cells(rowLoop, 2).Value <> "" Then 'if the current cell (changing row and fixed column B) has any data...
            For ColLoop = 2 To 14 'Loop through columns B-N
                Worksheets("Output").Cells(OutputRowCounter, ColLoop - 1).Value = Cells(rowLoop, ColLoop).Value 'copy selected data
           Next ColLoop 'go to next column
             OutputRowCounter = OutputRowCounter + 1 'store the next row in the output sheet
        End If
    Next rowLoop
End Sub

Questions:
Answers:

Here’s another way to do it. This puts your data in an array and then looks through the array for rows that have values in Column B. This should run a little faster than going through your column/sheet cell by cell, but the difference will probably be noticeable only for large data sets.

Sub summarize()

Dim sIn As Worksheet, sOut As Worksheet, rIn As Range, rOut As Range
Dim inputdata() As Variant
Dim tmpArr(1 To 3) As Variant
Dim i As Long, outcount As Long

Set sIn = Sheets("Input")
Set sOut = Sheets("Output")
Set rIn = sIn.UsedRange
Set rOut = sOut.Range("B2:D2")

'Loads input data into an array for fast processing.
inputdata = rIn.Value
outcount = 0

'Reads data from inputdata Array and prints selected values from columns B, I, and N on Output sheet row by row.
For i = 1 To UBound(inputdata, 1)
    If inputdata(i, 1) <> "" Then
        outcount = outcount + 1
        tmpArr(1) = inputdata(i, 1)
        tmpArr(2) = inputdata(i, 8)
        tmpArr(3) = inputdata(i, 13)
        rOut.Offset(outcount - 1, 0).Value = tmpArr
        Erase tmpArr
    End If
Next i
Erase inputdata
'Add "Scheduled Site" to Column E of Output data.
If sOut.Range("B2") <> "" Then
    sOut.Range("E2") = "Scheduled Site"
    sOut.Range("E2").AutoFill Destination:=sOut.Range("E2", sOut.Range("E2").Offset(outcount - 1, 0))
End If
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *