VBA to allow user to select where to add line with formulas

Alteran

Board Regular
Joined
Nov 25, 2009
Messages
117
Currently I have code that does this:

1) It finds a predefined last row and adds a new row with all the formula's required in a row for a user.
2) Takes the users data entered into the user form and puts it in the new row
3) Carry's the formula's down from top to bottom (the bottom being the defined last row)

Here is what I need it to do:

Add the new row where ever the user has selected the row, and still carry the formula's down to the last row.

This is what I am currently using for code:
Code:
Private Sub cmdPost_Click()
Dim LastRow As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
'This Code addes the line
    'Need to select the sheet incase user has entered any other objects
    Sheets("W510").Select
    Rows("8:8").Select
    Static answer
    answer = 1
            
    If answer > 0 Then
      Dim Counter
      Counter = 0   ' Initialize variables.
    
      Do While Counter < answer
        Counter = Counter + 1
        Range("last").EntireRow.Insert Shift:=xlDown ' new line
      Loop
    End If
        
    'Goes to the last row with anything in it in the Worksheet in column A
    LastRow = Worksheets("W510").Range("A65536").End(xlUp).Offset(1).Row
    'Puts values in cells (looks at the off set # meaning columns count)
        'Column A - Line #
        Cells(LastRow, 1).FormulaR1C1 = "=(R[-1]C+1)"
        'Column B - OPSC Code
        Cells(LastRow, 2).Value = cbOPSC
        'Column C - Authority Code
        Cells(LastRow, 3).Value = (cbAuthority * 1)
        
        'Column D is for the Project code currently not used.
        
            'Checking to see what type of workplan item is selected and place the text appropriate column
            If op1 = True Then
                'Column E - Objective
                Cells(LastRow, 5).Value = tbItem
            ElseIf op2 = True Then
                'Column F - Activity
                Cells(LastRow, 6).Value = tbItem
            ElseIf op3 = True Then
                'Column G - Deliverable
                Cells(LastRow, 7).Value = tbItem
            Else
                'Column G
                Cells(LastRow, 7).Value = ""
            End If
            'Column H - Lead
            Cells(LastRow, 8).Value = tbLead
            If tbFTE = "" Then
            'Column I - FTE for the lead
            Cells(LastRow, 9).Value = 0 * 1
            Else
            'Column I
            Cells(LastRow, 9).Value = (tbFTE * 1)
            End If
            'Column J - Completion Date
            Cells(LastRow, 10).Value = tbDate
            'Column K - Fiscal Year selector
            Range("K8").Formula = "=IF(ISERROR(IF(ISBLANK(J8),"""",IF((YEAR(J8))<2010,""2009/2010"",(IF((MONTH(J8))<4,""2009/2010"",""2010/2011""))))),"")"
            'Column L is used for the At Risk selection (used by person traking the budget only)
            '
            'Column M is used for Cutting a priority from the budget/workplan (used only by person tracking the budget)
            '
            'Column N - Budget Code
            Range("N8").Formula = "=IF(M8="""",(CONCATENATE($D$2,""-"",$B8,""-"",$C8)),(CONCATENATE($D$2,""-"",$B8,""-"",$C8,""-CUT"")))"
            'Need to Automate the Item #
            'Column O - Item #
            ' NEED TO AUTOMATE THE ITEM # BY USE OF A FORMULA TO POPULATE THE BOX
            'Column P - Travel
            Range("P8").Formula = "=IF(ISERROR(SUMIF('Travel Plan'!$B:$B,'W510'!$O8,'Travel Plan'!$M:$M)),"""",SUMIF('Travel Plan'!$B:$B,'W510'!$O8,'Travel Plan'!$M:$M))"
            'Column Q - Contracts - (Formula is setup to only calculate 2010/2011 amount)
            Range("Q8").Formula = "=IF(ISERROR(SUMIF(Contracts!$B:$B,'W510'!$O8,Contracts!$V:$V)),"""",SUMIF(Contracts!$B:$B,'W510'!$O8,Contracts!$V:$V))"
            'Column R - Hospitality
            Range("R8").Formula = "=IF(ISERROR(SUMIF('Hospitality Plan'!$B:$B,'W510'!$O8,'Hospitality Plan'!$N:$N)),"""",SUMIF('Hospitality Plan'!$B:$B,'W510'!$O8,'Hospitality Plan'!$N:$N))"
            'Column S - Industry Consultation
            Range("S8").Formula = "=IF(ISERROR(SUMIF('Meetings'!$B:$B,'W510'!$O8,'Meetings'!$N:$N)),"""",SUMIF('Meetings'!$B:$B,'W510'!$O8,'Meetings'!$N:$N))"
            'Column T - # of Students
            If tbStudents = "" Then
            Cells(LastRow, 20).Value = (0 * 1)
            Else
            Cells(LastRow, 20).Value = (tbStudents * 1)
            End If
            'Column U - Student estimated cost
            Range("U8").Formula = "=IF(ISBLANK($T8),"""",($T8*12000))"
            'Column V - Regional
            If tbRMoney = "" Then
            Cells(LastRow, 22).Value = (0 * 1)
            Else
            Cells(LastRow, 22).Value = (tbRMoney * 1)
            End If
            'Column W - G&C's
            If tbGC = "" Then
            Cells(LastRow, 23).Value = (0 * 1)
            Else
            Cells(LastRow, 23).Value = (tbGC * 1)
            End If
            'Column X - Temp Help
            If tbTempHelp = "" Then
                Cells(LastRow, 24).Value = (0 * 1)
            Else
                Cells(LastRow, 24).Value = (tbTempHelp * 1)
            End If
            'Column Y - Translation
            If tbTranslation = "" Then
            Cells(LastRow, 25).Value = (0 * 1)
            Else
            Cells(LastRow, 25).Value = (tbTranslation * 1)
            End If
            'Column Z - Information Services
            If tbIMIT = "" Then
            Cells(LastRow, 26).Value = (0 * 1)
            Else
            Cells(LastRow, 26).Value = (tbIMIT * 1)
            End If
            'Column AA - Other
            If tbOther = "" Then
            Cells(LastRow, 27).Value = (0 * 1)
            Else
            Cells(LastRow, 27).Value = (tbOther * 1)
            End If
            'Column AB - Planned OM Total
            Range("AB8").Formula = "=SUM($P8:$S8,$U8:$AA8)"
            'Column AC - Allocation - User Populated (Used only by the Budget administrator)
            '
            'Column AD - Revised Year to End Budget Forecast
            Range("AD8").Formula = "=SUM($AL8:$AW8)"
            'Column AE - Expenditures - User Populated (Used only by the Budget administrator)
            '
            'Column AF - Encumbrance - User Populated (Used only by the Budget administrator)
            '
            'Column AG - Left Over
            Range("AG8").Formula = "=SUM($AD8-($AE8+$AF8))"
            'Column AH - Uncertainties and Dependencies - User Populated (Used only by the Budget Administrator)
            '
            'Column AI - Notes
            Cells(LastRow, 35).Value = tbNotes.Value
            'Column AJ - Cut Count
            Range("AJ8").Formula = "=IF($M8=""Yes"",1,0)"
            'Column AK - BLANK Cell
            '
            'VARIENCES START HERE - These are all USER POPULATED (Used only by the Budget Administrator)
            'Column AL - April
            '
            'Column AM - May
            '
            'Column AN - June
            '
            'Column AO - July
            '
            'Column AP - August
            '
            'Column AQ - September
            '
            'Column AR - October
            '
            'Column AS - November
            '
            'Column AT - December
            '
            'Column AU - January
            '
            'Column AV - February
            '
            'Column AW - March
            '
            'Column AX - BLANK cell
            '
            ' ARE THESE USED FOR SOMETHING?
            'Column AZ - Cost Center -lookup
            Range("AZ8").Formula = "=$D$2"
            'Column BB - OPSC - lookup
            Range("BA8").Formula = "=$B8"
            'Column BC - Authority Code - lookup
            Range("BB8").Formula = "=$C8"
        'Copy the formulas down from Row 8 to the LastRow as defined:
            Range("K8").Copy Destination:=Range("K8:K" & LastRow)
            Range("N8").Copy Destination:=Range("N8:N" & LastRow)
            Range("P8").Copy Destination:=Range("P8:P" & LastRow)
            Range("Q8").Copy Destination:=Range("Q8:Q" & LastRow)
            Range("R8").Copy Destination:=Range("R8:R" & LastRow)
            Range("S8").Copy Destination:=Range("S8:S" & LastRow)
            Range("U8").Copy Destination:=Range("U8:U" & LastRow)
            Range("AB8").Copy Destination:=Range("AB8:AB" & LastRow)
            Range("AD8").Copy Destination:=Range("AD8:AD" & LastRow)
            Range("AG8").Copy Destination:=Range("AG8:AG" & LastRow)
            Range("AJ8").Copy Destination:=Range("AJ8:AJ" & LastRow)
            Range("AZ8").Copy Destination:=Range("AZ8:AZ" & LastRow)
            Range("BA8").Copy Destination:=Range("BA8:BA" & LastRow)
            Range("BB8").Copy Destination:=Range("BB8:BB" & LastRow)
                 
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Columns("A:A").Select ' Selects column A
    Selection.Copy 'Copies Column A
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False ' These two lines past special values to column A only
    Application.CutCopyMode = False
    Call UserForm_Initialize
End Sub

Are their any easy fixes or suggestions on what I could do?
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,216,101
Messages
6,128,842
Members
449,471
Latest member
lachbee

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top