Macro-Issues with 0

Need a little help with this Marco i have been creating. Basically i am taking a data file and formatting it in Excel then saving the formatted data as a new filename of the users choice forcing CSV. The issue i have is i am bulk applying the formula to a set number of row/columns to cover different amounts of incoming data. The OFFSET formatting works fine but if a OFFSET cell is linked to a cell with no data it displays a "0".

I need a way to remove the "0"s in the final saved file, or remove them before i create the new file. I can think of ways to remove the all "0"s but there are some i want to keep. See below for better understanding.

Bold "0"s are good, 0,0,0,0,0 are bad, how do i tell excel this!
A,B,C,D,234
A,B,C,D,33
A,B,C,D,0
A,B,C,D,34
A,B,C,D,0
A,B,C,D,3.9
A,B,C,D,3
A,B,C,D,3
0,0,0,0,0
0,0,0,0,0
0,0,0,0,0
0,0,0,0,0
0,0,0,0,0
0,0,0,0,0


Sub Pastemacro()
'
' Pastemacro Macro
' Created by Daniel Pelletier 03/09/11

' Set up Forumla in cells 5 by 300 Starting in B
Range("B1").Select
ActiveCell.FormulaR1C1 = _
        "=OFFSET(R1C1, (ROW()-1)*5+INT((COLUMN()-2)),MOD(COLUMN()-2,1))"
    Selection.AutoFill Destination:=Range("B1:F1"), Type:=xlFillDefault
    Range("B1:F1").Select
   Selection.AutoFill Destination:=Range("B1:F300"), Type:=xlFillDefault
    Range("B1:F300").Select
    
   'Open Data File, Copy Data
    ChDir "C:\Program Files\Worth Data\TriCoder Utilities"
    Workbooks.OpenText Filename:= _
        "C:\Program Files\Worth Data\TriCoder Utilities\DATA FILE #0.dat", Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.Copy
    
    'Paste Data into Main WB
    
    Windows("Upload_Scanner_Data.xls").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Create New workbook, Copy and paste formatted data in new WB
    
    Range("B1:F300").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Application.CutCopyMode = False

'Ask user for file name and location, auto select CSV
   
   Dim file_name As Variant
file_name = Application.GetSaveAsFilename(FileFilter:="CSV (Comma delimited) (*.Csv), *.csv")
    If file_name <> False Then
      ActiveWorkbook.SaveAs Filename:=file_name, FileFormat:= _
        xlCSV, CreateBackup:=False
      MsgBox "File Saved!"
    End If
  

    
End Sub

Open in new window

LVL 1
Daniel_P67Asked:
Who is Participating?
 
byundtConnect With a Mentor Commented:
I added statements to get rid of the rows with zeros. I also turned off screen updating so the macro runs much faster. And I got rid of the Select statements, once again so macro runs faster.

You will note that I put the .dat file in a different location than you did. You will need to change it back to your location. You may also need to adjust the file names (the ones you posted were named slightly differently than your macro expected).

Sub Pastemacro()
Dim rg As Range
Dim i As Long
' Pastemacro Macro
' Created by Daniel Pelletier 03/09/11

' Set up Formula in cells 5 by 300 Starting in B
Application.ScreenUpdating = False
Range("B1").FormulaR1C1 = _
        "=OFFSET(R1C1, (ROW()-1)*5+INT((COLUMN()-2)),MOD(COLUMN()-2,1))"
    Range("B1").AutoFill Destination:=Range("B1:F1"), Type:=xlFillDefault
    Range("B1:F1").AutoFill Destination:=Range("B1:F300"), Type:=xlFillDefault
    Range("B1:F300").Select
    
   'Open Data File, Copy Data
    'ChDir "C:\"
    ChDir "C:\"      'Please change Brad's test path in next statement
    Workbooks.OpenText Filename:= _
        "C:\VBA\Sample '11\DATA-FILE--0.dat", Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Columns("A:A").Copy
    
    'Paste Data into Main WB
    
    ThisWorkbook.Activate
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Create New workbook, Copy and paste formatted data in new WB
    
    Application.CutCopyMode = False
    Range("B1:F300").Copy
    Workbooks.Add
    Range("B1:F300").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Application.CutCopyMode = False
    
    Set rg = Range("B1:F300")
    For i = rg.Rows.Count To 1 Step -1
        If Application.CountIf(rg.Rows(i), 0) = Application.CountA(rg.Rows(i)) Then rg.Rows(i).EntireRow.Delete
    Next
Application.ScreenUpdating = True

'Ask user for file name and location, auto select CSV
   
   Dim file_name As Variant
file_name = Application.GetSaveAsFilename(FileFilter:="CSV (Comma delimited) (*.Csv), *.csv")
    If file_name <> False Then
      ActiveWorkbook.SaveAs Filename:=file_name, FileFormat:= _
        xlCSV, CreateBackup:=False
      MsgBox "File Saved!"
    End If
    ActiveWorkbook.Close SaveChanges:=False
    
End Sub

Open in new window


Brad
0
 
StephenJRCommented:
Could you post a sample workbook?
0
 
farzanjCommented:
You could use SED to remove those

sed "s/,0$//" filename

Open in new window

0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Daniel_P67Author Commented:
Looking up sed, not sure how it works.

Attached sample workbook, datafile, data file was renamed to .txt so i could upload it. Change back to .dat
Upload-Scanner-Data-Share.xls
DATA-FILE--0.txt
0
 
farzanjCommented:
What is exactly that you want to do.

If the file is produced on the Unix/Linux side and you need to remove last ",0" , wherever it exists, that is one simple sed command.  If you would like to write an excel macro to delete one last column, that is possible too.  Please let me know.
0
 
Daniel_P67Author Commented:
The data file comes from a Hand held device i can not run any commands on it. I need to take that file, reformat the data and convert it to CSV with different filenames .


Raw file

a
b
c
d
3
a
b
c
d
3
a
b
c
d
3
a
b
c
d
3
a
b
c
d
3
a
b
c
d
3

Converted to csv in the following format
a,b,c,d,3
a,b,c,d,3
a,b,c,d,3
a,b,c,d,3
a,b,c,d,3

0
 
Daniel_P67Author Commented:
Could you explain the logic behind the quoted code? How does it know to what rows to delete?

Thanks! I change the file names when i uploaded the file, sorry for missing something. The Code works great, made a change to paste the data to A-E instead of B-F like how you re-wrote it. Not that i am complaining!


Thanks for those speed up tips!

Set rg = Range("A1:E300")
    For i = rg.Rows.Count To 1 Step -1
        If Application.CountIf(rg.Rows(i), 0) = Application.CountA(rg.Rows(i)) Then rg.Rows(i).EntireRow.Delete
    Next

Open in new window

0
 
byundtCommented:
Daniel_P67,
The code loops through the rows from the bottom up. If you go from the top down, then you lose your place (need to tweak both the row counter and loop ending test) after deleting a row.
rg.Rows.Count           'Returns the number of rows in the range rg. It's 300 in your situation, but calculating it makes the code easier to update.

Open in new window

The macro then uses the worksheet functions COUNTA and COUNTIF. COUNTA returns a count of all the cells with numbers or text. COUNTIF returns a count of all the cells containing 0. If the two counts agree, then the row contains only 0 or blanks--and should be deleted.

Brad
0
 
Daniel_P67Author Commented:
Thanks! I like to understand what i am writing.
0
 
Daniel_P67Author Commented:
Great, just what i was looking for.


Thanks!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.