Inserting Rows with Specific Data in Multiple Designated Locations

Hi ExcelDummy

This can be done with VBA Code. Do you need to do the same for DevelopingCustomers?

Will this be a tool you'll need to use again for additional Commodities?

Hi ExcelDummy

Let me play with it a bit...see what I can come up with.

Hi ExcelDummy

Create a Test Folder...place both of the attached Workbooks in that Test Folder. Open the TestBook v1.1.xlsm. Click the Button.

The Code will ask you which Customer Profile Workbook you wish to modify. Select that Workbook (only one in this Test Folder...Customer Profilesv4 - Paul 7.24.14.xlsx)

The Code will then ask you to select the Row ABOVE which you wish to Insert a New Commodity. It'll further ask you to Name the New Commodity.

This Code is in TestBook and can be run on any Customer Profile Workbook that's of the SAME STRUCTURE.

Option Explicit

Sub Insert_Stuff()
  Dim MyPath As String, nCell As String, sAddress As String
  Dim wbSrc As Workbook
  Dim wsSrc As Variant
  Dim rng As Range, rCell As Range
  Dim LR As Long, YesNo As Long
  Dim Filter As String, Title As String
  Dim FilterIndex As Long
  Dim Filename As Variant

  MyPath = ThisWorkbook.Path & "\"
  ' File filters
  Filter = "Excel Files (*.xls*),*.xls*," & _
           "Text Files (*.txt),*.txt," & _
           "All Files (*.*),*.*"
  ' Default Filter to *.xls*
  FilterIndex = 1
  ' Set DialogCaption
  Title = "Select a File to Open"
  ChDir MyPath
  With Application
    ' Set File Name to selected File
    Filename = .GetOpenFilename(Filter, FilterIndex, Title)
  End With
  If Filename = False Then
    MsgBox "No file was selected."
    Exit Sub
  End If
  Workbooks.Open Filename

  Set wbSrc = ActiveWorkbook
  wbSrc.Activate

  On Error Resume Next
  Set rCell = Application.InputBox _
              (prompt:="Please Click on the Row Where" & vbCrLf & "New Item Should be Inserted.", _
               Title:="Add Item Here", Type:=8)
  On Error GoTo 0
  Application.DisplayAlerts = True

  If rCell Is Nothing Then
    Exit Sub
  End If

  If rCell.Address = "$B$3" Then
    MsgBox "Can't do that here!!!"
    Exit Sub
  End If


  nCell = Application.InputBox _
          (prompt:="Please Type the Name " & vbCrLf & "of the New Commodity.", _
           Title:="New Item Namee", Type:=2)
  On Error GoTo 0
  Application.DisplayAlerts = True

  If nCell = "" Then
    Application.ScreenUpdating = True
    Exit Sub
  End If

  YesNo = MsgBox(nCell & " will be inserted before every occurance " & rCell, vbYesNo + vbCritical)

  Application.ScreenUpdating = False
  Select Case YesNo
  Case vbYes
    With wbSrc
      For Each wsSrc In Array("CurrentCustomers", "DevelopingCustomers")
        With Sheets(wsSrc)
          .Activate
          LR = .Range("B" & .Rows.Count).End(xlUp).Row

          Set rng = .Range("B3:B" & LR).Find( _
                    what:=rCell, LookIn:=xlValues, lookat:=xlWhole, _
                    searchorder:=xlByRows)
          If rng Is Nothing Then
            Beep
            MsgBox prompt:="search string not found!"
            Application.ScreenUpdating = True
            Exit Sub
          End If

          sAddress = rng.Offset(1, 0).Address
          While .Range(rCell.Address) <> sAddress
            .Range(rng.Address).EntireRow.Insert
            .Range(rng.Address).Offset(-1, 0).Value = nCell
            LR = LR + 1
            Set rng = Cells.FindNext(After:=rng)
            If rng.Address = sAddress Then GoTo NextwsSrc
          Wend
        End With
NextwsSrc:
      Next wsSrc
    End With
  Case vbNo
    Application.ScreenUpdating = True
    Exit Sub
  Case Else
    Application.ScreenUpdating = True
    Exit Sub
  End Select
  Application.ScreenUpdating = True
End Sub

Hi ExcelDummy

On what line of Code

runtime error 13 - type mismatched

Alright...I'll try to get some help from a Member that has access to 2013...

just for test purpose change the DIM for Response to Variant and see what that does

Hi ExcelDummy

The Code in the attached incorporates the change suggested by Ernest. Ernest appears to have Excel 2010 and the Code performs as expected in 2010.

Replace the old File with this File. Run the Code...let us know...

thanks John

@Ernest

You're welcome...don't suppose you have access to Excel 2013???

nope...not really sure I want too....I figured Variant will cast the data type to whatever it needs....AND you can look in the locals window and see what the system is setting the data type too....yes, my English syntax sucks....

@Ernest

I had previously tested Variant in 2007 and 2010 and, of course, it worked. We'll see if 2013 likes it...hopefully.

Thanks for the input.

Original code works in xl2013.

@exceldummy, can you check if you have any missing references.
With the code workbook open,
ALT+F11 to go to VBE
Tools > References.

Any missing references will appear near the top of the list.

You must select only one cell and not whole row - this will cause Type Mismatch error.

@Izandol

I believe you may have discovered the issue...hope the OP hasn't given up.