swjtx99
asked on
Copy only cells with a value after deleting data
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
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
It copies only 388 lines when I do it.
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
ASKER
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
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
I'ved attached your spreadsheet after running the macro with line 4 added. Isn't this what you want?
Q-28531567.xlsm
Q-28531567.xlsm
ASKER
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
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
Did you open the workbook I posted? It copied only the rows that were left (388) after the macro deledted coffee.
ASKER
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
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
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
ASKER
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
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
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
ASKER
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
Can you attach a copy of of the production sheet with 10 or 20 rows with any sensitive obfuscated?
ASKER
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(xlCellTypeCon stants).Ar eas
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(xlCellTypeCon stants I think.
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(xlCellTypeCon
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(xlCellTypeCon
Yes it is.
ASKER
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 :-)
ASKER
...or spell properly :-)
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
In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014