none
need to delete blank rows from various worksheets in same workbook-reg RRS feed

  • Question

  • Hi Team,

    I am searching for a macro to delete the blank rows from my worksheets.

                                                                                   

    Sub testIt()
    Dim r As Long, endRow As Long, pasteRowIndex As Long, Worksheet As Object
    Application.ScreenUpdating = False
    endRow = 1000
    pasteRowIndex = 1

    For r = 1 To endRow

        If Cells(r, Columns("A").Column).Value = "12345" Then
                Rows(r).Select
                Selection.Copy
                Sheets("12345").Select
                Rows(pasteRowIndex).Select
                ActiveSheet.Paste
                CutCopyMode = False
                pasteRowIndex = pasteRowIndex + 1
                Sheets("NORMAL").Select

    End If




        If Cells(r, Columns("A").Column).Value = "45678" Then
                Rows(r).Select
                Selection.Copy
                Sheets("45678").Select
                Rows(pasteRowIndex).Select
                ActiveSheet.Paste
                pasteRowIndex = pasteRowIndex + 1
                Sheets("NORMAL").Select

        End If

        If Cells(r, Columns("A").Column).Value = "36925" Then
                Rows(r).Select
                Selection.Copy
                Sheets("36925").Select
                Rows(pasteRowIndex).Select
                ActiveSheet.Paste
                pasteRowIndex = pasteRowIndex + 1
                Sheets("NORMAL").Select

        End If

         If Cells(r, Columns("A").Column).Value = "789456" Then
                Rows(r).Select
                Selection.Copy
                Sheets("789456").Select
                Rows(pasteRowIndex).Select
                ActiveSheet.Paste
                pasteRowIndex = pasteRowIndex + 1
                Sheets("NORMAL").Select

    next r

    end sub()

    the above code searches for the value "12345" "45678" "36925" "789456" if found in worksheet (normal) then it picks the value and paste it in new corresponding worksheet with sheet number (12345). while pasting like this it has some blank rows so it need to delete the rows help me out of this problem. thanks in advance

    Wednesday, December 24, 2014 2:22 AM

Answers

  • Hi vigneshvicky,

    This code snippet works fine to delete the blank rows, please try it:

    ActiveSheet.UsedRange.Select
        'Deletes the entire row within the selection if the ENTIRE row contains no data.
        Dim i As Long
        'Turn off calculation and screenupdating to speed up the macro.
        With Application
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
        'Work backwards because we are deleting rows.
        For i = Selection.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
         Selection.Rows(i).EntireRow.Delete
        End If
        Next i
         .Calculation = xlCalculationAutomatic
         .ScreenUpdating = True
        End With


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, December 30, 2014 5:10 AM
    Moderator

All replies

  • re:  delete the blank rows

    One way is to sort the data.
    Blanks sort to the bottom.
    '---
    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Edited by James Cone Tuesday, November 1, 2016 12:34 AM
    Wednesday, December 24, 2014 3:49 AM
  • Hi vigneshvicky,

    This code snippet works fine to delete the blank rows, please try it:

    ActiveSheet.UsedRange.Select
        'Deletes the entire row within the selection if the ENTIRE row contains no data.
        Dim i As Long
        'Turn off calculation and screenupdating to speed up the macro.
        With Application
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
        'Work backwards because we are deleting rows.
        For i = Selection.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
         Selection.Rows(i).EntireRow.Delete
        End If
        Next i
         .Calculation = xlCalculationAutomatic
         .ScreenUpdating = True
        End With


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, December 30, 2014 5:10 AM
    Moderator