CopyPaste Macro to skip blank cells and zero values OR Delete Blank Cells and zero values

D

Daniel_15

New Member
Joined
Apr 8, 2015
Messages
29
Hi
I am trying to write a copypaste macro that will only paste non-blank or non-zero values (the CopyNonZeroValues macro). The “EXAMPLE_RANGE” the macro is referring to is a worksheet that has a bunch of formula driven outputs. If the formula returns a zero, I have it return/formatted as “”. Based on this I believe the macro is still taking those values. So I tried another macro to clean this up on the “upload” worksheet. However, instead of deleting rows that appear blank, it keeps them. When I test the “blank” cells in column which contains the pasted data I get varying answers. Testing the cell value with a 0=0 returns FALSE but a Len() test returns 0. So that is a bit confusing. There must be a carry over from the original copied data and formula.
Ultimately, I am trying to get one macro that will copypaste data into a new worksheet and not carry over blanks or zero values cells (compress the data so there are not any empty rows) and then write this data to a text file. I have tried the writing to a text file yet because I can’t seem to get by this first step.

Thank you for your consideration.

Here is the code.

Sub CopyNonZeroValues()
' Defines variables
Dim cRange As Range
Set cRange = Range("EXAMPLE_RANGE")
Range("EXAMPLE_RANGE").Copy
Sheets("upload").Range("D4").PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True

End Sub

Sub DeleteAllEmptyRows()
Dim SourceRange As Range
Dim EntireRow As Range

Set SourceRange = Application.Sheets("upload").Range("D1:D600")

If Not (SourceRange Is Nothing) Then
Application.ScreenUpdating = False

For I = SourceRange.Rows.Count To 1 Step -1
Set EntireRow = SourceRange.Cells(I, 1).EntireRow
If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
EntireRow.Delete
End If
Next

Application.ScreenUpdating = True
End If

End Sub
 
Sort by date Sort by votes
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Hi Akuini,

I have a question. I need the write to file to put quotation marks around all text (excluding lines that start with // or numbers). Please see example below.

"//$DDL 2012.1 'Not this line for example because of the "//" or any other line with "//"
//NewSeries
//Issuer
MUD 'Need quotes on this line and others like it
//IssuerTitle
Harris Co MUD # 105 'Need quotes on this line
//NewSeries
//Issuer
MUD
//IssuerTitle
Harris Co MUD # 105
//Series
19A_WS
//SeriesTitle
U/L Tax Bds Ser 2019A
//SeriesStatus
Act
//Dated
09/01/2019 'No quotes here for example because it is a number
//Deliv
09/01/2019
//FirstInt
03/01/2020
//IntFreq
6
//Basis
30/360
//BeginBondDescription
//Name
SER
//Title
Serial Bonds
//Options
Serial
//BeginMaturityTable 25
03/01/2024,110000,0.02,0.0145,, 'No quotes on these lines either for example
03/01/2025,200000,0.02,0.015,,
03/01/2026,200000,0.02,0.0155,,
03/01/2027,250000,0.02,0.017,,
03/01/2028,275000,0.02,0.018,,
03/01/2029,300000,0.0225,0.019,,
03/01/2030,300000,0.0225,0.02,,
03/01/2031,300000,0.0225,0.0205,,
03/01/2032,325000,0.0225,0.0215,,
03/01/2033,350000,0.0225,0.0225,,
03/01/2034,350000,0.02375,0.024,,
03/01/2035,350000,0.025,0.024,,
03/01/2036,375000,0.025,0.025,,
03/01/2037,375000,0.025,0.0255,,
03/01/2038,400000,0.025,0.0258,,
03/01/2039,425000,0.025,0.026,,
03/01/2040,425000,0.02625,0.028,,
03/01/2041,450000,0.02625,0.028,,
03/01/2042,450000,0.02625,0.028,,
03/01/2043,500000,0.02625,0.028,,
03/01/2044,525000,0.02625,0.028,,
03/01/2045,525000,0.0275,0.0282,,
03/01/2046,525000,0.0275,0.0283,,
03/01/2047,550000,0.0275,0.0284,,
03/01/2048,555000,0.0275,0.0285,,
//EndMaturityTable
//Series
19A_WS
//SeriesTitle
U/L Tax Bds Ser 2019A
//SeriesStatus
Act
//Dated
09/01/2019
//Deliv
09/01/2019
//FirstInt
03/01/2020
//IntFreq
6
//Basis
30/360
//BeginBondDescription
//Name
SER
//Title
Serial Bonds
//Options
Serial
//BeginMaturityTable 25
03/01/2024,110000,0.02,0.0145,,
03/01/2025,200000,0.02,0.015,,
03/01/2026,200000,0.02,0.0155,,
03/01/2027,250000,0.02,0.017,,
03/01/2028,275000,0.02,0.018,,
03/01/2029,300000,0.0225,0.019,,
03/01/2030,300000,0.0225,0.02,,
03/01/2031,300000,0.0225,0.0205,,
03/01/2032,325000,0.0225,0.0215,,
03/01/2033,350000,0.0225,0.0225,,
03/01/2034,350000,0.02375,0.024,,
03/01/2035,350000,0.025,0.024,,
03/01/2036,375000,0.025,0.025,,
03/01/2037,375000,0.025,0.0255,,
03/01/2038,400000,0.025,0.0258,,
03/01/2039,425000,0.025,0.026,,
03/01/2040,425000,0.02625,0.028,,
03/01/2041,450000,0.02625,0.028,,
03/01/2042,450000,0.02625,0.028,,
03/01/2043,500000,0.02625,0.028,,
03/01/2044,525000,0.02625,0.028,,
03/01/2045,525000,0.0275,0.0282,,
03/01/2046,525000,0.0275,0.0283,,
03/01/2047,550000,0.0275,0.0284,,
03/01/2048,555000,0.0275,0.0285,,
//EndMaturityTable
 
Upvote 0
here is the current code.

Sub Write_Directly_to_Text_File()
Dim strFile_Path As String
Dim obj As New DataObject
Dim tx As String
Range("EXAMPLE_RANGE").Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False

tx = Replace(tx, vbLf & 0 & vbCr, "")
tx = Replace(tx, vbLf & vbCr, "")
strFile_Path = ThisWorkbook.Path & "\DDL Upload" & Format(Now, "mm_dd_yy h_mm AM/PM") & ".ddl"

Open strFile_Path For Append As #1
Write #1 , tx
Close #1
End Sub
 
Upvote 0
OK, try tyhis:
Note: if you're using Windows 8.1/Excel 2013 there's a bug you should know related to clipboard object. Read this article:
https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard

And I'm indeed using Windows 8.1/Excel 2013, so when I run this code it will put 4 double quotes instead of 2 around the intended lines.
Let's see how it works on your side.


Code: 
[FONT=Lucida Console][COLOR=Royalblue]Sub[/COLOR] a1112370d()
    [COLOR=Royalblue]Dim[/COLOR] strFile_Path [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] obj [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]New[/COLOR] DataObject
    [COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

    Range([COLOR=Darkcyan]"A1:A20"[/COLOR]).Copy
    obj.GetFromClipboard
    tx = obj.GetText
    Application.CutCopyMode = False
    
        tx = Replace(tx, vbLf & [COLOR=Brown]0[/COLOR] & vbCr, [COLOR=Darkcyan]""[/COLOR])
        tx = Replace(tx, vbLf & vbCr, [COLOR=Darkcyan]""[/COLOR])
        
        ary = Split(tx, vbCrLf)
        [COLOR=Royalblue]For[/COLOR] i = [COLOR=Royalblue]LBound[/COLOR](ary) [COLOR=Royalblue]To[/COLOR] [COLOR=Royalblue]UBound[/COLOR](ary)
            
            z = ary(i)
            [COLOR=Royalblue]If[/COLOR] Len(z) > [COLOR=Brown]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
                [COLOR=Royalblue]If[/COLOR] Left(z, [COLOR=Brown]2[/COLOR]) <> [COLOR=Darkcyan]"//"[/COLOR] [COLOR=Royalblue]And[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(Left(z, [COLOR=Brown]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
                    ary(i) = Chr([COLOR=Brown]34[/COLOR]) & z & Chr([COLOR=Brown]34[/COLOR])
                [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            
[I][COLOR=Dimgray]'            Debug.Print z[/COLOR][/I]
        [COLOR=Royalblue]Next[/COLOR]
        
        tx = Join(ary, vbCrLf)
        'Debug.Print tx
        strFile_Path = [COLOR=Darkcyan]"D:\zz\tezt2.txt"[/COLOR] [I][COLOR=Dimgray]'Change to suit[/COLOR][/I]

        Open strFile_Path [COLOR=Royalblue]For[/COLOR] Append [COLOR=Royalblue]As[/COLOR] #[COLOR=Brown]1[/COLOR]
        Write #[COLOR=Brown]1[/COLOR], tx
        Close #[COLOR=Brown]1[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Last edited:
Upvote 0
Ok, thank you for letting me know. I will read the article and give the code a try. Thanks again and have a great weekend.
 
Upvote 0
Ok, just replace this line:

Code: 
Write #1, tx

with this:

Code: 
Print #1, tx

And you still want to use your previous requirements (i.e removing the blank cell & cell with zero), right?
otherwise just remove this part:

Code: 
        tx = Replace(tx, vbLf & 0 & vbCr, "")
        tx = Replace(tx, vbLf & vbCr, "")
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
referenced blank cell returned zero (0) as values
Replies
5
Views
440
Peter_SSs
Peter_SSs
edge37
  • Solved
Help modifying a code for filling blanks in selected range with zeroes
Replies
8
Views
283
NoSparks
N
M
  • Question Question
Cell with 0 value showing blank
2
Replies
15
Views
687
mhessnm
M
L
  • Solved
Linking Data on Different Tab and Showing Blank Values Instead of Zeroes
Replies
3
Views
435
Fluff
Fluff
B
  • Question Question
VBA Code to Send Mail to skip blank cells
Replies
1
Views
271
Micron
M

Forum statistics

Threads
1,223,705
Messages
6,173,988
Members
452,541
Latest member
haasro02

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top