Consulting

Results 1 to 15 of 15

Thread: Hiding rows depending on data in first cell

  1. #1

    Hiding rows depending on data in first cell

    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

  2. #2
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    To filter blank rows try this.
    .AutoFilter Field:=1, Criteria1:="<>"

  3. #3
    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)

  4. #4
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    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

  5. #5
    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.

  6. #6
    mmm and now i get an error on


    Range("A1").select

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

  7. #7
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    It should copy the font and other formatting fine. Can you zip your workbook and attach it here?

  8. #8
    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

  9. #9
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    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.

  10. #10
    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

  11. #11
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Ok, that seems fine. Now what exactly is getting copied over that you don't want?

  12. #12
    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.

  13. #13
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    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

  14. #14
    that worked fine thanks.
    that solved all my problems, I'll change the thread title.

    Thanks a lot

    Frank

  15. #15
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    You're Welcome

    Take Care

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •