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)

 

[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?

 

[shina67]

Let's go back to post #5 where the code filtered and not deleted. An adjustment of that code should delete the rows. The code seemed to work fine for filtering so the small adjustment for deleting should work.

Sub copyto_test()
    Dim lrow As Long, srow As Long, crow As Long
    Dim slist As String, srng As String, trng As String
    Dim aws As Worksheet, tws As Worksheet
    Dim rng 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 = "K" & srow & ":AQ" & crow
    slist = "K" & srow & ":AQ" & crow

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

    aws.Range("K" & srow & ":AQ" & crow).EntireRow.Delete

    tws.AutoFilterMode = False
    
Application.CutCopyMode = False
End Sub

 

[Keebler]

okay.. im concerned about a line of VBA code provided here
aws.Range("K" & srow & ":AQ" & crow).EntireRow.Delete

i do not want to delete ANYTHING from the active sheet
the aws is the activesheet

 

[shina67]

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?

A constant is a named value that remains unchanged during the execution the code.