I have a Form for my excel with Text Boxes BelowRow and NumberOfRows that I use to get values for which cell the user wants to insert below and how many rows they would like to insert. The formulas must be included in the new rows so I copy the "BelowRow" and insert it above the row beneath it (i.e. if the user selects 10 for "BelowRow", the code will copy row 10 and insert it above row 9). This works fine except one formula is not copying down on the 'PUMP SUMMARY' sheet like it does on the 'CONCRETE SUMMARY' sheet. The formula in cell B10 of the PUMP SUMMARY sheet is =If('CONCRETE SUMMARY'!B10="","",'CONCRETE SUMMARY'!B10). The 2 sheets need to show the same information across rows (row B10 on the PUMP SUMMARY sheet needs to =B10 on the CONCRETE SUMMARY Sheet). The CONCRETE SUMMARY sheet has a similar formula that copies down just fine. On my form, if I put 2 as NumberOfRows and 10 as BelowRow, the PUMP SUMMARY sheet shows the following:
Before:
Cell B9's formula = =IF('CONCRETE SUMMARY'!B9="","",'CONCRETE SUMMARY'!B9)
Cell B10's formula = =IF('CONCRETE SUMMARY'!B10="","",'CONCRETE SUMMARY'!B10)
After:
Cell B9's formula = =IF('CONCRETE SUMMARY'!B9="","",'CONCRETE SUMMARY'!B9)
Cell B10's formula = =IF('CONCRETE SUMMARY'!B11="","",'CONCRETE SUMMARY'!B11)
Cell B11's formula = =IF('CONCRETE SUMMARY'!B12="","",'CONCRETE SUMMARY'!B12)
Cell B12's formula = =IF('CONCRETE SUMMARY'!B13="","",'CONCRETE SUMMARY'!B13)
I've tried using Offset a million different ways to get thing to work correctly, but I don't understand why it doesn't work like it does on the CONCRETE SUMMARY sheet where the code begins. That sheet's cells have formulas that reference the row they're in and it works fine. Please help! Code below:
Private Sub Add_Click()
If BelowRow <= 8 Then
If MsgBox("You Must Insert Below The Header", vbOKOnly) Then
AddAreaForm.BelowRow.Value = ""
AddAreaForm.NumberOfRows.Value = ""
Exit Sub
End If
End If
Dim intNumberOfRows As Integer
Dim intBelowRow As Integer
Dim RowIns As Integer
Dim CopyRow As Integer
Application.ScreenUpdating = True
If IsNumeric(BelowRow) And IsNumeric(NumberOfRows) Then
intNumberOfRows = NumberOfRows.Value
intBelowRow = BelowRow.Value
RowIns = 2
'Section for CONCRETE SUMMARY sheet that works fine'
Cells(intBelowRow, 1).Select
ActiveCell.EntireRow.Select
Selection.Copy
Cells(intBelowRow, 1).Select
Selection.EntireRow.Insert
Cells(intBelowRow, 2).Offset(1, 0).Select
Selection.ClearContents
Range("CopyCells").Copy
Cells(intBelowRow, 4).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
For RowIns = 2 To intNumberOfRows
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Application.CutCopyMode = False
Next RowIns
'Section for PUMP SUMMARY'
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("CONCRETE SUMMARY", "POUR ENTRY", "PUMP SUMMARY", "PUMP ENTRY", "PRICING")).Select
Sheets("PUMP SUMMARY").Activate
Cells(intBelowRow, 1).Select
ActiveCell.EntireRow.Select
Selection.Copy
Cells(intBelowRow, 1).Select
Selection.EntireRow.Insert
Range("CopyCells2").Copy
Cells(intBelowRow, 2).Offset(1, 0).Select
ActiveSheet.Paste
For RowIns = 2 To intNumberOfRows
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Selection.Offset(1, 0).EntireRow.Insert
Application.CutCopyMode = False
Next RowIns
Application.CutCopyMode = False
AddAreaForm.BelowRow.Value = ""
AddAreaForm.NumberOfRows.Value = ""
AddAreaForm.Hide
End If
End Sub
Thank you for any help!
Before:
Cell B9's formula = =IF('CONCRETE SUMMARY'!B9="","",'CONCRETE SUMMARY'!B9)
Cell B10's formula = =IF('CONCRETE SUMMARY'!B10="","",'CONCRETE SUMMARY'!B10)
After:
Cell B9's formula = =IF('CONCRETE SUMMARY'!B9="","",'CONCRETE SUMMARY'!B9)
Cell B10's formula = =IF('CONCRETE SUMMARY'!B11="","",'CONCRETE SUMMARY'!B11)
Cell B11's formula = =IF('CONCRETE SUMMARY'!B12="","",'CONCRETE SUMMARY'!B12)
Cell B12's formula = =IF('CONCRETE SUMMARY'!B13="","",'CONCRETE SUMMARY'!B13)
I've tried using Offset a million different ways to get thing to work correctly, but I don't understand why it doesn't work like it does on the CONCRETE SUMMARY sheet where the code begins. That sheet's cells have formulas that reference the row they're in and it works fine. Please help! Code below:
Private Sub Add_Click()
If BelowRow <= 8 Then
If MsgBox("You Must Insert Below The Header", vbOKOnly) Then
AddAreaForm.BelowRow.Value = ""
AddAreaForm.NumberOfRows.Value = ""
Exit Sub
End If
End If
Dim intNumberOfRows As Integer
Dim intBelowRow As Integer
Dim RowIns As Integer
Dim CopyRow As Integer
Application.ScreenUpdating = True
If IsNumeric(BelowRow) And IsNumeric(NumberOfRows) Then
intNumberOfRows = NumberOfRows.Value
intBelowRow = BelowRow.Value
RowIns = 2
'Section for CONCRETE SUMMARY sheet that works fine'
Cells(intBelowRow, 1).Select
ActiveCell.EntireRow.Select
Selection.Copy
Cells(intBelowRow, 1).Select
Selection.EntireRow.Insert
Cells(intBelowRow, 2).Offset(1, 0).Select
Selection.ClearContents
Range("CopyCells").Copy
Cells(intBelowRow, 4).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
For RowIns = 2 To intNumberOfRows
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Application.CutCopyMode = False
Next RowIns
'Section for PUMP SUMMARY'
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("CONCRETE SUMMARY", "POUR ENTRY", "PUMP SUMMARY", "PUMP ENTRY", "PRICING")).Select
Sheets("PUMP SUMMARY").Activate
Cells(intBelowRow, 1).Select
ActiveCell.EntireRow.Select
Selection.Copy
Cells(intBelowRow, 1).Select
Selection.EntireRow.Insert
Range("CopyCells2").Copy
Cells(intBelowRow, 2).Offset(1, 0).Select
ActiveSheet.Paste
For RowIns = 2 To intNumberOfRows
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Selection.Offset(1, 0).EntireRow.Insert
Application.CutCopyMode = False
Next RowIns
Application.CutCopyMode = False
AddAreaForm.BelowRow.Value = ""
AddAreaForm.NumberOfRows.Value = ""
AddAreaForm.Hide
End If
End Sub
Thank you for any help!