CODEWITHSUNDEEP
excelinsertrowvba
Lazyeye
Lazyeye

Reputation: 87

Add cells to range of columns only

I am attempting to write a macro (new to VBA/writing code) that will add a value to an existing list (Col B). The value is defined by an InputBox then added in the list in alphabetical order. I am able to get the macro to work, however I would like to add cells in a range instead of an entire row.

My spreadsheet has data in columns A through K. This is the area that I want to insert a 'row' into. There is a catch however. I have another set of data in columns L through AF which I do not want to add the row to. This is where I have failed as I am only able to insert a complete row.

Is there a way to do this? I have not run across any methods that seem to work as the insert must happen based on the new value's position in the list (alphabetically) which prevents me from selecting the location to insert. I have tried recording macros to view the code and am unable to manipulate that input due to the selection being defined by the value.

Here is the code that I have so far...may be a bit clunky as I am still learning.

Sub Add_Project()
Dim NewProject As String, iRow As Long, ProjRng As Range, RowRng As Range
'The ProjRng MUST represent the project column!
    Set ProjRng = Range("B:B")
'Defines the range of columns to add a row to
    Set RowRng = Range("B:K")
'Create message box for user input on project name
    NewProject = InputBox("Enter Project Name")
    If NewProject = "" Then Exit Sub
'Determines if the New Project name already exists
    iRow = Application.WorksheetFunction.Match(NewProject, ProjRng)
    If Cells(ProjRng.row + iRow - 1, ProjRng.Column) = NewProject Then
        MsgBox ("Project already exists")
Exit Sub
    End If
'Inserts a new row with containing the new Project name
    With Cells(ProjRng.row + iRow, ProjRng.Column)
        .EntireRow.Insert
        .Offset(-1, 0).Value = NewProject
    End With
Exit Sub
End Sub

I realize that the macro is doing what I have instructed it to do. I would like to manipulate the section adding an "EntireRow" with something that only adds to the range of column A:K. Any suggestions or pointers as to where I could get started would be much appreciated. Thanks!

Upvotes: 0

Views: 1051

Answers (1)

tigeravatar
tigeravatar

Reputation: 26650

Sub Add_Project()

    Dim strNewProject As String
    Dim iRow As Long

    strNewProject = InputBox("Enter Project Name")
    If Len(strNewProject) = 0 Then Exit Sub 'Pressed cancel

    If WorksheetFunction.CountIf(Columns("B"), strNewProject) > 0 Then
        MsgBox "Project already exists"
        Exit Sub
    End If

    iRow = WorksheetFunction.Match(strNewProject, Columns("B")) + 1
    Intersect(Range("A:K"), Rows(iRow)).Insert xlShiftDown
    Cells(iRow, "B").Value = strNewProject

End Sub

Upvotes: 1

Related Questions