locked
how to insert value in individual cells in inserted row after aplying auto filter RRS feed

  • Question

  • Hi,

    the below code inserts row after each record of autofilter but am not able to insert value in cells of inserted row Please help its urgent

    -----------Code -------------------------

    Option Explicit
    Dim afRow As Long
    Dim rng As Range
    Dim cRng As Range
    Sub Macro1()
    '
    ' Macro1 Macro
    '

    '
           Application.ThisWorkbook.Worksheets("Sheet1").Range("A1").AutoFilter Field:=1, Criteria1:="=*EBNIN*" '_
           ' , Operator:=xlAnd
           Set rng = Application.ThisWorkbook.Worksheets("Sheet1").AutoFilter.Range _
           .Offset(1, 0).Resize(Application.ThisWorkbook.Worksheets("Sheet1").AutoFilter.Range.Rows.Count - 1) _
            .SpecialCells(xlCellTypeVisible)
             'set a range = to visible cells (excluding the  header)
              For Each cRng In rng.Areas
                    cRng.Offset(1, 0).EntireRow.Insert shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
                    cRng.Offset(1, 0).Value = "EBNIN"
                    cRng.Offset(1, 1).Value = 1
                     cRng.Offset(1, 2).Value = 2
                Next cRng

    End Sub

     

    regards,

    Shweta.

    Saturday, July 30, 2011 6:02 AM

Answers

  • One more. If I follow, you want to insert a row below each filtered row and put some data in it

    ['vbnet]
       For Each cRng In rng.Areas
           For i = cRng.Count To 1 Step -1
               cRng(i + 1, 1).EntireRow.Insert shift:=xlDown
               cRng(i + 1, 1).Value = "EBNIN"
               cRng(i + 1, 2).Value = 1
               cRng(i + 1, 3).Value = 2
           Next
       Next cRng
    [/vbnet]

    Peter Thornton

    • Marked as answer by Bruce Song Monday, August 8, 2011 10:57 AM
    Saturday, July 30, 2011 10:13 AM
  • Hello again Shweta,

    I had 2 earlier posts here but deleted them because with further testing they were not performing as expected. My testing indicates that this one works as expected.

    set rng to only one column wide.
    See the following section of the code extracted from the Set rng line.

    .Resize(Application.ThisWorkbook.Worksheets("Sheet1") _
                    .AutoFilter.Range.Rows.Count - 1, 1)    'Note the last comma and 1 for 1 column wide

    Need to work backwards from the bottom up. You will see where I have included some lines that gives a visual test for the lines that were inserted.

    The code takes into account contiguous cells within areas.

    Sub Macro1()

    Dim rng As Range
    Dim j As Long
    Dim i As Long


           Application.ThisWorkbook.Worksheets("Sheet1").Range("A1") _
           .AutoFilter Field:=1, Criteria1:="=*EBNIN*"
          
          'Set a range = One column of visible cells (excluding the  header)
           Set rng = Application.ThisWorkbook.Worksheets("Sheet1").AutoFilter.Range _
                    .Offset(1, 0) _
                    .Resize(Application.ThisWorkbook.Worksheets("Sheet1") _
                    .AutoFilter.Range.Rows.Count - 1, 1) _
                    .SpecialCells(xlCellTypeVisible)
           
             
              With rng
                  For j = .Areas.Count To 1 Step -1
                    For i = .Areas(j).Cells.Count To 1 Step -1
                      '**********************************************
                      'Between the asterisk lines used for testing only
                      'Reference Cell prior to insert.
                      .Areas(j).Cells(i, 1).Interior.ColorIndex = 3 'Red
                      '**********************************************
                     
                      .Areas(j).Cells(i, 1).Offset(1, 0).EntireRow.Insert shift:=xlUp, _
                                CopyOrigin:=xlFormatFromLeftOrAbove
                     
                      .Areas(j).Cells(i, 1).Offset(1, 0).Value = "EBNIN"
                      .Areas(j).Cells(i, 1).Offset(1, 1).Value = 1
                      .Areas(j).Cells(i, 1).Offset(1, 2).Value = 2
                     
                      '***********************************************************
                      'Between the asterisk lines used for testing only
                      'Cell in the inserted rows
                      .Areas(j).Cells(i, 1).Offset(1, 0).Interior.ColorIndex = 6  'Yellow
                      '***********************************************************
                     
                    Next i
                  Next j
              End With
    End Sub


    Regards, OssieMac

    • Marked as answer by Bruce Song Monday, August 8, 2011 10:57 AM
    Saturday, July 30, 2011 11:22 AM

All replies

  • One more. If I follow, you want to insert a row below each filtered row and put some data in it

    ['vbnet]
       For Each cRng In rng.Areas
           For i = cRng.Count To 1 Step -1
               cRng(i + 1, 1).EntireRow.Insert shift:=xlDown
               cRng(i + 1, 1).Value = "EBNIN"
               cRng(i + 1, 2).Value = 1
               cRng(i + 1, 3).Value = 2
           Next
       Next cRng
    [/vbnet]

    Peter Thornton

    • Marked as answer by Bruce Song Monday, August 8, 2011 10:57 AM
    Saturday, July 30, 2011 10:13 AM
  • Hello again Shweta,

    I had 2 earlier posts here but deleted them because with further testing they were not performing as expected. My testing indicates that this one works as expected.

    set rng to only one column wide.
    See the following section of the code extracted from the Set rng line.

    .Resize(Application.ThisWorkbook.Worksheets("Sheet1") _
                    .AutoFilter.Range.Rows.Count - 1, 1)    'Note the last comma and 1 for 1 column wide

    Need to work backwards from the bottom up. You will see where I have included some lines that gives a visual test for the lines that were inserted.

    The code takes into account contiguous cells within areas.

    Sub Macro1()

    Dim rng As Range
    Dim j As Long
    Dim i As Long


           Application.ThisWorkbook.Worksheets("Sheet1").Range("A1") _
           .AutoFilter Field:=1, Criteria1:="=*EBNIN*"
          
          'Set a range = One column of visible cells (excluding the  header)
           Set rng = Application.ThisWorkbook.Worksheets("Sheet1").AutoFilter.Range _
                    .Offset(1, 0) _
                    .Resize(Application.ThisWorkbook.Worksheets("Sheet1") _
                    .AutoFilter.Range.Rows.Count - 1, 1) _
                    .SpecialCells(xlCellTypeVisible)
           
             
              With rng
                  For j = .Areas.Count To 1 Step -1
                    For i = .Areas(j).Cells.Count To 1 Step -1
                      '**********************************************
                      'Between the asterisk lines used for testing only
                      'Reference Cell prior to insert.
                      .Areas(j).Cells(i, 1).Interior.ColorIndex = 3 'Red
                      '**********************************************
                     
                      .Areas(j).Cells(i, 1).Offset(1, 0).EntireRow.Insert shift:=xlUp, _
                                CopyOrigin:=xlFormatFromLeftOrAbove
                     
                      .Areas(j).Cells(i, 1).Offset(1, 0).Value = "EBNIN"
                      .Areas(j).Cells(i, 1).Offset(1, 1).Value = 1
                      .Areas(j).Cells(i, 1).Offset(1, 2).Value = 2
                     
                      '***********************************************************
                      'Between the asterisk lines used for testing only
                      'Cell in the inserted rows
                      .Areas(j).Cells(i, 1).Offset(1, 0).Interior.ColorIndex = 6  'Yellow
                      '***********************************************************
                     
                    Next i
                  Next j
              End With
    End Sub


    Regards, OssieMac

    • Marked as answer by Bruce Song Monday, August 8, 2011 10:57 AM
    Saturday, July 30, 2011 11:22 AM
  • Hi Shweta,

    How about the problem on your side? Do the suggestions help you or not? If you still show any concern on the problem, just feel free to follow up.

    Best Regards,


    Bruce Song [MSFT]
    MSDN Community Support | Feedback to us
    Get or Request Code Sample from Microsoft
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Wednesday, August 3, 2011 9:50 AM