PDA

View Full Version : [SOLVED] Hiding rows depending on data in first cell



Regouin
02-21-2005, 01:21 AM
Hello everyone,

I am new to all this, but please be kind enough to help me.
I am trying to get a sheet to only display the data that is of any importance. When i dont want the row to show the first cell is empty. Otherwise it shows text.

What i have accomplished thus far by snooping around the board is making the rows dissapear when the first row is zero, but i cant get it to select the rows when their blank, most attempts just hid all the rows.



Sub HideRows()
Dim ws As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
With ws
.AutoFilterMode = False
With .Range("a1")
.EntireRow.Hidden = _
(CBool(Len(.Value)) And _
.Value = 0)
End With
Range(.Cells(1, 1), .Cells(65336, 1).End(xlUp)) _
.AutoFilter Field:=1, Criteria1:="<>0", _
visibleDropDown:=False
End With
Next
Application.ScreenUpdating = True
End Sub


then after that i want excel to export just the displayed data into either a text or a new sheet, thus far i have managed to export all the data (including the hidden lines) into a text file.


Sub createtext()
Set fsoObj = CreateObject("Scripting.FileSystemObject")
Dim Fs As Object
Dim strPath As String
Dim strFileMask As String
Dim f As String
Dim stKallFil As String
Set Fs = CreateObject("Scripting.FileSystemObject")
If MsgBox(strExcelApp & "Onderhoudsgegevens versturen?", _
vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
With fsoObj
If .FolderExists("C:\tempmail\") Then
Else
.CreateFolder ("C:\tempmail")
End If
Application.ScreenUpdating = False
Sheets("hoofd").Select
Sheets("hoofd").Copy
ActiveWorkbook.SaveAs Filename:="C:\tempmail\onderhoud.xls", _
FileFormat:=xlText, CreateBackup:=False
ActiveWindow.Close
On Error Resume Next
'Kill "C:\tempmail\*.*"
'RmDir "C:\tempmail"
End With
Set fsoObj = Nothing
End Sub


then after that i want it to send an email out with the txt file attached, but I'll get to that later, first i want this to work.

TIA Frank

Jacob Hilderbrand
02-21-2005, 01:34 AM
To filter blank rows try this.

.AutoFilter Field:=1, Criteria1:="<>"

Regouin
02-21-2005, 01:57 AM
thanks jake, that solved the first problem, i tried several possibilities with the criteria but according to the standard help files. This one got it working the i want it.


now I only need to solve the problem with exporting just the displayed rows and preferably maintain the text format (certain things are bold and I want them to stay that way)

Jacob Hilderbrand
02-21-2005, 02:05 AM
To export just the visible cells try this.



Option Explicit

Sub Export()
Dim Wkb As Workbook
Range("A:A").SpecialCells(xlCellTypeVisible).EntireRow.Copy
Set Wkb = Workbooks.Add
Wkb.Sheets(1).Paste
Range("A1").Select
Application.CutCopyMode = False
Set Wkb = Nothing
End Sub

Regouin
02-21-2005, 02:08 AM
but now it doesnt export it to a text file yet, or does it, and if not where do i put it in the original code?

Or do i get it to export sheet "1" instead of the original sheet?

tia


got it, it fixed the job, i now only export the visible cells, but the problem is that it doesnt maintain the font format, so it looses all the bold fonts.

Regouin
02-21-2005, 02:15 AM
mmm and now i get an error on



Range("A1").select


ok, I left this bit out and it basically does what i wanted

Jacob Hilderbrand
02-21-2005, 02:20 AM
It should copy the font and other formatting fine. Can you zip your workbook and attach it here?

Regouin
02-21-2005, 02:30 AM
It copies the format and font just fine, i had it saving as text that was the problem, got that fixed now. Problem is that it also copies the macro buttons i created. And I want the recipient to just see the generated data and not how i get it.

I'll attach the workbook.

tia

file is too large, 800 kb as a zip file

Jacob Hilderbrand
02-21-2005, 02:39 AM
When you copy the data to a new workbook there should not be any code copied over. Post the complete macro that you are using now.

Regouin
02-21-2005, 02:47 AM
Sub createtext()
Set fsoObj = CreateObject("Scripting.FileSystemObject")
Dim Fs As Object
Dim strPath As String
Dim strFileMask As String
Dim f As String
Dim stKallFil As String
Dim recipients As String
Set Fs = CreateObject("Scripting.FileSystemObject")
If MsgBox(strExcelApp & "Onderhoudsgegevens versturen?", _
vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
With fsoObj
If .FolderExists("C:\tempmail\") Then
Else
.CreateFolder ("C:\tempmail")
End If
Application.ScreenUpdating = False
Dim Wkb As Workbook
Range("A:A").SpecialCells(xlCellTypeVisible).EntireRow.Copy
Set Wkb = Workbooks.Add
Wkb.Sheets(1).Paste
'Range("A1").Select
Application.CutCopyMode = False
Set Wkb = Nothing
recipients = ActiveSheet.Range("b5:d5")
ActiveWorkbook.SaveAs Filename:= _
"C:\tempmail\onderhoud.xls", CreateBackup:=False
ActiveWorkbook.SendMail recipients, "onderhoud"
ActiveWindow.Close
On Error Resume Next
Kill "C:\tempmail\*.*"
RmDir "C:\tempmail"
End With
Set fsoObj = Nothing
End Sub

Jacob Hilderbrand
02-21-2005, 02:54 AM
Ok, that seems fine. Now what exactly is getting copied over that you don't want?

Regouin
02-21-2005, 04:18 AM
it copies the boxes which i use to start the macro's with in the original workbook. When I press them in the generated copy they link to the macro in the other workbook, and i want them completely removed from the copy.

Jacob Hilderbrand
02-21-2005, 04:37 AM
Ok, Try this. After this line:


Application.CutCopyMode = False

Add this:


Dim Shp As Shape
For Each Shp In Wkb.Sheets(1).Shapes
Shp.Delete
Next

Regouin
02-21-2005, 05:17 AM
that worked fine thanks.
that solved all my problems, I'll change the thread title.

Thanks a lot

Frank

Jacob Hilderbrand
02-21-2005, 05:25 AM
You're Welcome :beerchug:

Take Care