Solved

Copy only cells with a value after deleting data

Posted on 2014-10-05
19
163 Views
Last Modified: 2014-10-06
Hi,

After deleting a selection of rows, I want to only copy the cells/rows that are not blank. In the example file, it's copying blank rows as you can see after running the macro. The sheet starts out with 500 rows, after deletion, there are only 388 rows which are all I want to copy. The number of rows to copy will not always be 388.

Thanks in advance,

swjtx99Book1.xlsm
0
Comment
Question by:swjtx99
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 9
19 Comments
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362252
It copies only 388 lines when I do it.
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362256
Oh, I see the problem. If you are looking at Sheet2 when you run the macro it doesn't work correctly. So add line 4.
Sub Delete_Data()

Dim rng As Range, cell As Range, del As Range
Sheets("Sheet1").Activate

Set rng = Sheets("Sheet1").Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For Each cell In rng

 Select Case cell.Value
    Case "Coffee"
            If del Is Nothing Then
                Set del = cell
            Else
                Set del = Union(del, cell)
            End If
            End Select
Next cell
On Error Resume Next
del.EntireRow.Delete


    Sheets("Sheet1").Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste

End Sub

Open in new window

0
 

Author Comment

by:swjtx99
ID: 40362286
Hi MartinLiss,

Thanks for the reply but that wasn't the problem.

The problem is that the code is copying all 500 rows instead of just the 388 that contain data.

Thanks,

swjtx99
0
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362306
I'ved attached your spreadsheet after running the macro with line 4 added. Isn't this what you want?
Q-28531567.xlsm
0
 

Author Comment

by:swjtx99
ID: 40362341
Hi MartinLiss,

If you open the sheet I originally attached and run the Macro it deletes every row where column C contains the word Coffee, leaving 388 rows with data, however, when the data is copied to sheet2, it selects and copies 500 rows. I only want to select and copy the 388 rows with data. I do not want to include the 112 blank rows.

Thanks,

swjtx99
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362362
Did you open the workbook I posted? It copied only the rows that were left (388) after the macro deledted coffee.
0
 

Author Comment

by:swjtx99
ID: 40362381
Hi MartinLiss,

The workbook you posted was "saved" thus the lastrow was reset so it appears it worked, however, it did not. If I copy and paste that code to my original workbook, it's still copying 500 rows to sheet2, 112 of which are blank.

Thanks,

swjtx99
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362399
See if this is better.

Sub Delete_Data()

Dim rng As Range, cell As Range, del As Range
Sheets("Sheet1").Activate
Set rng = Sheets("Sheet1").Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For Each cell In rng

 Select Case cell.Value
    Case "Coffee"
            If del Is Nothing Then
                Set del = cell
            Else
                Set del = Union(del, cell)
            End If
            End Select
Next cell
On Error Resume Next
del.EntireRow.Delete


    Sheets("Sheet1").Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste
    ActiveSheet.Range("A1").Select

End Sub

Open in new window

0
 

Author Comment

by:swjtx99
ID: 40362409
Hi MartinLiss,

Thanks for your help but that didn't work. If you look back at sheet1 it shows 500 rows selected and if you look at sheet 2, the vertical scroll bar doesn't reach the bottom until you are at row 500 so it clearly copied 500 rows still.

I was thinking that perhaps looking for the last cell that contained a value and setting whatever row it was in the "lastrow", then using that, select the rows to copy?

Thanks,

swjtx99
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362479
I added a call to a second macro named DeleteUnused.
Sub Delete_Data()

Dim rng As Range, cell As Range, del As Range
Sheets("Sheet1").Activate
Set rng = Sheets("Sheet1").Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For Each cell In rng

 Select Case cell.Value
    Case "Coffee"
            If del Is Nothing Then
                Set del = cell
            Else
                Set del = Union(del, cell)
            End If
            End Select
Next cell
On Error Resume Next
del.EntireRow.Delete


    Sheets("Sheet1").Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste
    DeleteUnused
    ActiveSheet.Range("A1").Select
End Sub
Sub DeleteUnused()

Dim lngLastRow As Long
Dim lngLastCol As Long
Dim dummyRng As Range

  With Sheets("Sheet2")
    lngLastRow = 0
    lngLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    lngLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    lngLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If lngLastRow * lngLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(lngLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, lngLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With

End Sub

Open in new window

0
 

Author Comment

by:swjtx99
ID: 40362769
Hi MartinLiss,

Thanks again for your reply. This deletes blank rows after copying but it's still copying 500 rows. Is there no method of copying only rows where at least one cell is not blank (contains data/value)?

Thanks,

swjtx99
0
 
LVL 48

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 40362780
OK finally got it. Note the change in line 24.

Sub Delete_Data()

Dim rng As Range, cell As Range, del As Range
Sheets("Sheet1").Activate
Set rng = Sheets("Sheet1").Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For Each cell In rng

 Select Case cell.Value
    Case "Coffee"
            If del Is Nothing Then
                Set del = cell
            Else
                Set del = Union(del, cell)
            End If
            End Select
Next cell
On Error Resume Next
del.EntireRow.Delete


    Sheets("Sheet1").Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlCellTypeConstants)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste
    'DeleteUnused
    ActiveSheet.Range("A1").Select
End Sub

Open in new window

0
 

Author Comment

by:swjtx99
ID: 40362820
Hi MartinLiss,

This worked on the example sheet but when I inserted it into my production sheet, instead of selecting A2 down to the last cell, it selected A2 up to the top cell (so basically the top two rows). I'm mystified.

Thanks,

swjtx99
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362829
Can you attach a copy of of the production sheet with 10 or 20 rows with any sensitive obfuscated?
0
 

Author Comment

by:swjtx99
ID: 40362855
Unfortunately I work for the government so I can't,  however I found this and it seems to work:

Sheets("Sheet1").Activate
Dim r As Range, r2 As Range

For Each r In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row). _
                SpecialCells(xlCellTypeConstants).Areas
    If r2 Is Nothing Then
        Set r2 = r.Resize(, 11)
    Else
        Set r2 = Union(r2, r.Resize(, 11))
    End If
Next r

r2.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste

That's sort of where you were going with the SpecialCells(xlCellTypeConstants I think.
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40362857
Yes it is.
0
 

Author Closing Comment

by:swjtx99
ID: 40362912
Thanks! Always appreciate the help I get here. Also impressed with the patience of those who offer help. Please keep it up. We that ask don't always aks the right question the first time :-)
0
 

Author Comment

by:swjtx99
ID: 40362914
...or spell properly :-)
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40363717
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

717 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question