new project: copy range without empty or blank rows

[Keebler]

I am currently working on a project to copy a range from one worksheet to another removing empty or blank cells (rows) and pasting them into another ws at the bottom of the page.

Sub copyto_test()
'define variables
Dim lrow As Long, srow As Long, erow As Long, crow As Long
Dim slist As String, srng As String, trng As String
Dim aws As Worksheet, sws As Worksheet, tws As Worksheet
Dim crg As Range

'set constants
Set aws = activesheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1") 'gets the last row of destination ws
If lrow <= 3 Then 'checks to make sure row is at least row 3
trng = tws.Range("a3").Address
Else
trng = tws.Range("a" & (lrow + 1))
End If
crow = aws.Range("e1") 'gets the last row of the current sheet
srow = aws.Range("h1") 'gets the first row of the current sheet
srng = Range("aa" & crow)
slist = ("k" & srow & ":" & srng)


Range(slist).Copy Range(trng).PasteSpecial(xlPasteValues)




End Sub

so the problem is the last line.

Range(slist).Copy Range(trng).PasteSpecial(xlPasteValues)

unable to get the pastespecial property of the range class

im sure it is something stupid im missing...

no other errors are showing up --- at this time (and no i havent tried the removal of the blank rows yet)

 

[Keebler]

Did you try the new code I put on post #14. You had said it worked before but needed the filter removing and delete empty rows instead. The above code in post #14 does that b

MY BAD!!!
I failed to see your new post when I posted the 2 follow up posts.

I will run the revision and report back... (which ironically is quite similar to what you posted) (I see that you have added the clipboard clean, and the autofiltering turned off)

Sub delblnkrows_test5() 'failed
Dim tws As Worksheet
Dim lrow As Long, i As Long
Dim rng As Range

Set tws = Sheets("INDEX")
'Set rng = ws.Range("a3:a20")
lrow = tws.Range("a" & tws.Rows.Count).End(xlUp).row
  

 ' Filter out blank or empty rows in the target worksheet
    Set rng = tws.Range("A3:A" & lrow)
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    tws.AutoFilterMode = False
 
  
    Application.CutCopyMode = False

End Sub

result
same error

run time error '1004':
No cells were found

I can clearly see multiple empty rows

FLAC MASTERS 3 1 555b307.xlsm
	A
18	ABBA - I HAVE A DREAM - 100% ABBA {DISC 1} 2019 - 19 - FMA0101 [ALBUMS]
19	ABBA - OUR LAST SUMMER - 100% ABBA {DISC 1} 2019 - 23 - FMA0101 [ALBUMS]
20	ABBA - THE DAY BEFORE YOU CAME - 100% ABBA {DISC 1} 2019 - 24 - FMA0101 [ALBUMS]
21	ABBA - ANGEL EYES - 100% ABBA {DISC 1} 2019 - 25 - FMA0101 [ALBUMS]
22
23
24	ABBA - SUMMER NIGHT CITY - 100% ABBA {DISC 2} 2019 - 01 - FMA0101 [ALBUMS]
25	ABBA - HEAD OVER HEELS - 100% ABBA {DISC 2} 2019 - 02 - FMA0101 [ALBUMS]
26	ABBA - EAGLE (SHORT VERSION) - 100% ABBA {DISC 2} 2019 - 03 - FMA0101 [ALBUMS]
27	ABBA - THE VISITORS - 100% ABBA {DISC 2} 2019 - 04 - FMA0101 [ALBUMS]
INDEX

FLAC MASTERS 3 1 555b307.xlsm
	A
50	ABBA - BUMBLEBEE - VOYAGE 2021 - 08 - FMA0101 [ALBUMS]
51	ABBA - ODE TO FREEDOM - VOYAGE 2021 - 10 - FMA0101 [ALBUMS]
52
53
54
55
56	ACE OF BASE - WONDERFUL LIFE - DA CAPO [JAPAN PROMO] 2003 - 07 - FMA0101 [ALBUMS]
57
58
59	ACE OF BASE - TRAVEL TO ROMANTIS - FLOWERS 1998 - 04 - FMA0101 [ALBUMS]
60	ACE OF BASE - DONNIE - FLOWERS 1998 - 13 - FMA0101 [ALBUMS]
61	ACE OF BASE - CRUEL SUMMER {BONUS MIX} - FLOWERS 1998 - 14 - FMA0101 [ALBUMS]
62
63
64	ACE OF BASE - EVERYTIME IT RAINS - GREATEST HITS 2000 - 03 - FMA0101 [ALBUMS]
65	ACE OF BASE - BEAUTIFUL LIFE {JUNIOR VASQUEZ MIX} - GREATEST HITS 2000 - 12 - FMA0101 [ALBUMS]
66
67
68	ACE OF BASE - CRUEL SUMMER {BONUS MIX} - GREATEST HITS 2008 - 12 - FMA0101 [ALBUMS]
69
70
71	ACE OF BASE - EVERYTIME IT RAINS - PLAYLIST THE VERY BEST OF ACE OF BASE 2011 - 09 - FMA0101 [ALBUMS]
72	ACE OF BASE - ALWAYS HAVE, ALWAYS WILL - PLAYLIST THE VERY BEST OF ACE OF BASE 2011 - 12 - FMA0101 [ALBUMS]
73
74
75	ACE OF BASE - LOVE IN DECEMBER - SINGLES OF THE 90S 1999 - 06 - FMA0101 [ALBUMS]
76	ACE OF BASE - CRUEL SUMMER - SINGLES OF THE 90S 1999 - 11 - FMA0101 [ALBUMS]
77	ACE OF BASE - NEVER GONNA SAY I'M SORRY - SINGLES OF THE 90S 1999 - 14 - FMA0101 [ALBUMS]
78
79
80	ACE OF BASE - RAVINE - THE BRIDGE [JAPAN EDITION] 1995 - 06 - FMA0101 [ALBUMS]
81	ACE OF BASE - WHISPERS IN BLINDNESS - THE BRIDGE [JAPAN EDITION] 1995 - 09 - FMA0101 [ALBUMS]
82	ACE OF BASE - YOU AND I - THE BRIDGE [JAPAN EDITION] 1995 - 11 - FMA0101 [ALBUMS]
INDEX

 

[Keebler]

what i can not understand is why this works

Sub delblnkrows_test4() 'worked
Dim ws As Worksheet
Dim lrow As Long
Dim rng As Range

Set ws = Sheets("INDEX")
Set rng = ws.Range("a3:a20")

'rng.SpecialCells(xlCellTypeBlanks).EntireRow.Select
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

FLAC MASTERS 3 1 555b307.xlsm
	A
3	test
4	test
5
6
7	test
8	test
9	test
10	test
11
12	test
13	test
14
15
16
17
18	test
19	test
INDEX

FLAC MASTERS 3 1 555b307.xlsm
	A
3	test
4	test
5	test
6	test
7	test
8	test
9	test
10	test
11	test
12	test
13
14
15
16
17
18
19
INDEX

 

[Keebler]

what am i missing?

 

[shina67]

Try this.

Sub delblnkrows_test4()
    Dim ws As Worksheet
    Dim lrow As Long
    Dim rng As Range
    Dim blankCells As Range

    Set ws = Sheets("INDEX")
    Set rng = ws.Range("A3:A20")

    On Error Resume Next
    Set blankCells = rng.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If Not blankCells Is Nothing Then
        ' Delete entire rows containing blank cells
        blankCells.EntireRow.Delete
    Else
        MsgBox "No blank cells found in the specified range."

    End If
End Sub

This code checks for blank cells in A3:A20 before attempting to delete rows. If no blank cells are found, it displays a message box stating that no blank cells were found.

 

[Keebler]

SAME ERROR (no blank cells found)
just a message box this time

I DID change the range to a3:a30 no change same error

Sub delblnkrows_test6()
    Dim ws As Worksheet
    Dim lrow As Long
    Dim rng As Range
    Dim blankCells As Range

    Set ws = Sheets("INDEX")
    Set rng = ws.Range("A3:A30")

    On Error Resume Next
    Set blankCells = rng.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If Not blankCells Is Nothing Then
        ' Delete entire rows containing blank cells
        blankCells.EntireRow.Delete
    Else
        MsgBox "No blank cells found in the specified range."

    End If
End Sub

FLAC MASTERS 3 1 555b307.xlsm
	A
15	ABBA - FERNANDO - 100% ABBA {DISC 1} 2019 - 16 - FMA0101 [ALBUMS]
16	ABBA - THE NAME OF THE GAME - 100% ABBA {DISC 1} 2019 - 17 - FMA0101 [ALBUMS]
17	ABBA - CHIQUITITA - 100% ABBA {DISC 1} 2019 - 18 - FMA0101 [ALBUMS]
18	ABBA - I HAVE A DREAM - 100% ABBA {DISC 1} 2019 - 19 - FMA0101 [ALBUMS]
19	ABBA - OUR LAST SUMMER - 100% ABBA {DISC 1} 2019 - 23 - FMA0101 [ALBUMS]
20	ABBA - THE DAY BEFORE YOU CAME - 100% ABBA {DISC 1} 2019 - 24 - FMA0101 [ALBUMS]
21	ABBA - ANGEL EYES - 100% ABBA {DISC 1} 2019 - 25 - FMA0101 [ALBUMS]
22
23
24	ABBA - SUMMER NIGHT CITY - 100% ABBA {DISC 2} 2019 - 01 - FMA0101 [ALBUMS]
25	ABBA - HEAD OVER HEELS - 100% ABBA {DISC 2} 2019 - 02 - FMA0101 [ALBUMS]
26	ABBA - EAGLE (SHORT VERSION) - 100% ABBA {DISC 2} 2019 - 03 - FMA0101 [ALBUMS]
27	ABBA - THE VISITORS - 100% ABBA {DISC 2} 2019 - 04 - FMA0101 [ALBUMS]
28	ABBA - ON AND ON AND ON - 100% ABBA {DISC 2} 2019 - 06 - FMA0101 [ALBUMS]
29	ABBA - I WONDER (DEPARTURE) - 100% ABBA {DISC 2} 2019 - 09 - FMA0101 [ALBUMS]
30	ABBA - LOVELIGHT {ORIGINAL VERSION} - 100% ABBA {DISC 2} 2019 - 11 - FMA0101 [ALBUMS]
INDEX

is it at all possible that the errors are a result of the formatting? (i ask ,because cells with one word "test" work fine) the data is copied from another sheet (values only) with no formulas or extra nonsense
or does the VBA code not care what is actually in the cells being evaluated? barring a blank or empty cell

i changed the range to a20:a30 (just to try it)
result: same error
(no blank cells found in the specified range)

 

[Keebler]

FLAC MASTERS 3 1 555b307.xlsm
	A
135
136
137
138
139
140	test
141	test
142
143
144
145
146	test
147	test
148	test
149	test
150
151
152	test
153	test
154
155
INDEX

the only change
Set rng = ws.Range("A135:A155")

FLAC MASTERS 3 1 555b307.xlsm
	A
135	test
136	test
137	test
138	test
139	test
140	test
141	test
142	test
143
144
145
146
147
148
149
150
151
152
153
154
155
INDEX

this doesnt make any sense to me..
can you please explain this to me?

 

[Keebler]

i tried changing the range
Set rng = ws.Range("A3:j60") I wanted to rule out the range not seeing the "whole" line even though it is all in the A column

this had a TERRIBLE result
deleted EVERYTHING above a60 and moved everything up to a3

is it possible that the VBA code is somehow not seeing the A column and looking elsewhere?

 

[shina67]

I really do not understand what is happening here. Let's try a different approach.
The following code will copy the range from one worksheet to another removing empty or blank rows and then paste them into another sheet.

Sub copyto_test()

    Dim lrow As Long, srow As Long, erow As Long, crow As Long
    Dim slist As String, srng As String, trng As String
    Dim aws As Worksheet, sws As Worksheet, tws As Worksheet
    Dim crg As Range

    Set aws = ActiveSheet
    Set tws = Sheets("INDEX")

    lrow = tws.Cells(tws.Rows.Count,"E").End(xlUp).Row

    If lrow <= 3 Then
        trng = tws.Range("A3").Address
    Else
        trng = tws.Cells(lrow + 1, 1).Address
    End If

    crow = aws.Cells(aws.Rows.Count, "E").End(xlUp).Row
    srow = aws.Cells(aws.Rows.Count, "H").End(xlUp).Row
    srng = "AA" & crow
    slist = "K" & srow & ":" & srng

 aws.Range(slist).SpecialCells(xlCellTypeConstants).Copy
    tws.Range(trng).PasteSpecial xlPasteValues

    Application.CutCopyMode = False
End Sub

 

[Keebler]

so, i tried the new vba code

Sub copyto_test_b9()

    Dim lrow As Long, srow As Long, erow As Long, crow As Long
    Dim slist As String, srng As String, trng As String
    Dim aws As Worksheet, sws As Worksheet, tws As Worksheet
    Dim crg As Range

    Set aws = activesheet
    Set tws = Sheets("INDEX")

    lrow = tws.Cells(tws.Rows.Count, "a").End(xlUp).row

    If lrow <= 3 Then
        trng = tws.Range("A3").Address
    Else
        trng = tws.Cells(lrow + 1, 1).Address
    End If

crow = aws.Range("e1") 'gets the last row of the current sheet
srow = aws.Range("h1") 'gets the first row of the current sheet
    srng = "k" & crow
    slist = "K" & srow & ":" & srng

 aws.Range(slist).SpecialCells(xlCellTypeConstants).Copy
    tws.Range(trng).PasteSpecial xlPasteValues

    Application.CutCopyMode = False
End Sub

as you can see, i had to change a couple lines to more closely fit what I have (also I changed the range to slim it down to only one column)
the code failed but the range variables all reported the correct values (k8:k914), and the fullrange (slist) showed everything correct;y


Run-time error '1004':
No cells were found

im at a loss as to why NOW I am getting the no cells fund error...


note:
my original vba code works just fine copying the data from one sheet to the INDEX page

 

[Keebler]

i think the issue with the revised VBA code is the
aws.Range(slist).SpecialCells(xlCellTypeConstants).Copy

specifically the xlCellTypeConstants

so, for clarification : what is a constant within the scope of EXCEL?