Insert Rows

**Mysore** · 01-20-2012, 11:30 PM

--------------------------------------------------------------------------------

Hi Guys,

I have basically 2 sheets of same structure. The First sheet holds data and flow into the second sheet to perform some calculations. I need a macro to do the following,

--> In Sheet A, when the rows gets exhausted (I have a row for totals Say Row 715) before this total Row, I need a new row to be populated automatically (I mean macros based on event) and copy the formula from above.
To illustrate, when row 714 is filled up, a new row should populate between row 714 and row 715(Total Row) and copy the formula only from Row 714.

--> The above should happen in Sheet B at the same specified rows .

Any help is much appreciated.

Thanks

**JapanDave** · 01-20-2012, 11:51 PM

Can you post a dummy workbook?

**Mysore** · 01-21-2012, 12:48 AM

Hi Dave,

Please see a sample workbook as attached.
Hope this helps.

Thanks

**JapanDave** · 01-21-2012, 04:47 AM

Hey,

Give this workbook a try

The macro will only fire when you enter a value in the cell above the cell with the string "Total" in it on sheet 1.

Sub d()
 
 Dim ws As Worksheet, wsM As Worksheet
 Dim i&, LR&
 Dim cel As Double
   
   Set ws = Sheets("Sheet2")
   Set wsM = Sheets("Sheet1")
   LR = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row
       wsM.Rows(LR).EntireRow.Insert
       ws.Rows(LR).EntireRow.Insert
            For i = 3 To 6
             cel = wsM.Application.Sum(Range(Cells(4, i), Cells(LR, i)))
              wsM.Cells(LR + 1, i).Value = cel
            Next i
       wsM.Cells(LR, 6).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
       ws.Cells(LR, 6).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
        cel = 0
         For i = 1 To 5
          cel = ws.Application.Sum(Range(Cells(4, i), Cells(LR, i)))
            ws.Cells(LR, i).FormulaR1C1 = "=Sheet1!RC"
             If i >= 3 Then
               ws.Cells(LR + 1, i).Value = cel
             End If
         Next i
   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim LR&, cel As Range
   LR = Cells(Rows.Count, 1).End(xlUp).Row
   Set cel = Cells(LR - 1, 1)
    If Not Intersect(Target, cel) Is Nothing Then
       Call d
    End If
End Sub

**Mysore** · 01-21-2012, 09:15 AM

Thanks Dave.

Just wondering now whether it would be possible to insert 100 rows instead of 1 row.
If so can you give the code or update straight on the workbook.

Thanks once again for your help.

**JapanDave** · 01-21-2012, 12:13 PM

Hey ,
Try this, again the cell above the total cell will fire the macro.

Sub d()
 
 Dim ws As Worksheet, wsM As Worksheet
 Dim i&, LR&
 Dim cel As Double
   
   Set ws = Sheets("Sheet2")
   Set wsM = Sheets("Sheet1")
   LR = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row
       wsM.Rows(LR).Resize(100).EntireRow.Insert
       ws.Rows(LR).Resize(100).EntireRow.Insert
            For i = 3 To 6
             cel = wsM.Application.Sum(Range(Cells(4, i), Cells(LR, i)))
              wsM.Cells(LR + 1, i).Value = cel
            Next i
       wsM.Cells(LR, 6).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
       ws.Cells(LR, 6).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
        cel = 0
         For i = 1 To 5
          cel = ws.Application.Sum(Range(Cells(4, i), Cells(LR, i)))
            ws.Cells(LR, i).FormulaR1C1 = "=Sheet1!RC"
             If i >= 3 Then
               ws.Cells(LR + 1, i).Value = cel
             End If
         Next i
   
End Sub

**Mysore** · 01-22-2012, 08:09 PM

Hi Dave

Sorry to note that now I realise that my two sheets are not indentical. No of Columns with formula in sheet2 varies with sheet1.
However there is a text called "Total" under Column A in both the sheets. I want to insert 100 rows before this row which has "Total" under column A.
The macro should also copy formula from above. Note no of columns in Sheet 2 are different in Sheet 1.
Can you resend the code please?

Many Thanks

**JapanDave** · 01-22-2012, 08:27 PM

Can you attach the workbook with the new layout?

**Mysore** · 01-22-2012, 10:23 PM

Hi Dave,

I have atttached the sheet and also put a note in sheet 1.
Hope this is clear.
Thanks

Appreciate your help.

**JapanDave** · 01-22-2012, 10:34 PM

What columns in sheet 2 do you want formulas input into?

**Mysore** · 01-22-2012, 10:59 PM

Columns A to Column AF in Sheet 2

**Mysore** · 01-23-2012, 02:14 AM

Hi Dave,

Any luck yet?
Thanks

**JapanDave** · 01-24-2012, 02:18 AM

OK,

The code is done. I need emphasize that the format or layout can not be changed or the Macro will cease to work.

When there is less than 100 rows in column A the macro will fire and insert 100 extra rows and so on and so forth.

Sub d()
 
 Dim ws As Worksheet, wsM As Worksheet
 Dim i&, LR&, LC&, rng As Range, cel2 As Range
 Dim cel As Variant, cADD As Variant, bRng As Range
 
 
 Application.ScreenUpdating = 0
   Set ws = Sheets("Sheet2")
   Set wsM = Sheets("Sheet1")
   
   LR = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row
   LC = wsM.Cells(12, wsM.Columns.Count).End(xlToLeft).Column
   
   
   Set rng = wsM.Range(Cells(15, 6), Cells(16, LC))
       wsM.Rows(LR).Resize(100).EntireRow.Insert
       ws.Rows(LR).Resize(100).EntireRow.Insert
     With wsM
           For Each cel In rng
                If cel = "Y/N" Then
                    cADD = cel.Address
                     .Range(cADD).Offset(1).Resize(84 + LR).FormulaR1C1 = "=IF(RC3="""","""",IF(RC4=2011,""Yes"",IF(AND(RC4=2012,OR(RC5=""Na"",RC5=""Jan"",RC5=""Feb"",RC5=""Mar"")),""Yes"",""No"")))"
                     .Range(cADD).Offset(1, 1).Resize(84 + LR).FormulaR1C1 = "=SUM(RC[-7]:RC[-2])"
               
                ElseIf cel = "Qtr 4" Then
                  cADD = cel.Address
                   Set cel2 = .Range(cADD).Offset(1)
                   If cel2 = "Y/N" Then
                     cADD = cel2.Address
                      .Range(cADD).Offset(1).Resize(84 + LR).FormulaR1C1 = "=IF(RC3="""","""",IF(RC4=2011,""Yes"",IF(AND(RC4=2012,OR(RC5=""Na"",RC5=""Jan"",RC5=""Feb"",RC5=""Mar"")),""Yes"",""No"")))"
                      .Range(cADD).Offset(1, 1).Resize(84 + LR).FormulaR1C1 = "=SUM(RC[-7]:RC[-2])"
                      .Range(cADD).Offset(1, 2).Resize(84 + LR).FormulaR1C1 = "=IF(AND(RC12=""Yes"",RC20=""Yes"",RC28=""Yes"",RC36=""Yes""),""Yes"",""No"")"
                      .Range(cADD).Offset(2, 3).Resize(84 + LR).FormulaR1C1 = "=RC[-26]+RC[-18]+RC[-10]+RC[-2]"
                  End If
                End If
           Next cel
              Border .Range(Cells(17, 1), Cells(LR + 99, 39))
              Border .Range(Cells(17, 42), Cells(LR + 99, 75))
              Border .Range(Cells(17, 78), Cells(LR + 99, 111))
              Border .Range(Cells(17, 114), Cells(LR + 99, 147))
        End With
              
         ws.Activate
      With ActiveSheet
        LC = .Cells(15, .Columns.Count).End(xlToLeft).Column
        
            .Range("A17:AF17").Copy
          For i = 17 To LR + 99
             .Range("A" & i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
          Next i
            
            Border .Range(Cells(17, 1), Cells(LR + 99, 5))
            Border .Range(Cells(17, 7), Cells(LR + 99, 12))
            Border .Range(Cells(17, 15), Cells(LR + 99, 20))
            Border .Range(Cells(17, 23), Cells(LR + 99, 32))
             
            .Cells(LR + 100, 4).FormulaR1C1 = "=COUNTIF( R[" & -LR - 83 & "]C:R[-1]C,""Yes"")"
            .Cells(LR + 100, 9).Resize(, 4).FormulaR1C1 = "=COUNT(R[" & -LR - 83 & "]C:R[-1]C)"
            .Cells(LR + 100, 19).Resize(, 2).FormulaR1C1 = "=COUNT(R[" & -LR - 83 & "]C:R[-1]C)"
      End With
        
        wsM.Activate
        
   Application.ScreenUpdating = 1
End Sub
Sub Border(rng As Range)
     
    With rng
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            .Color = 16764057
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            .Color = 16764057
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            .Color = 16764057
        End With
    End With
     
End Sub

This code fires the Macro above,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim LR&, cel&
    LR = Cells(Rows.Count, 1).End(xlUp).Row
  
   If Intersect(ActiveCell, Range("A17:A" & LR)) Is Nothing Then
       cel = Application.WorksheetFunction.CountBlank(Range("A17:A" & LR))
        If cel < 100 Then
          Call d
      End If
    End If
       
End Sub

**Mysore** · 01-24-2012, 03:57 AM

Thank you very much Dave. Appreciate your efforts. Many Thanks

Thread: Insert Rows

Thread Tools

Display

Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Re: Insert Rows

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions