Creating a new row in Excel VBA macro (what am I doing wrong?)

I am working on an Excel macro that merges two spreadsheets – a list of companies, and a list of emails associated with those companies. Whenever a company has more than one email associated, I need to create a separate row for that email.

Everything goes correctly until I attempt to create the new row with the code Rows(row).Resize(1).Insert towards the end of the macro. As soon as it gets to this line, Excel duplicates each row’s first column ad infinitum (until column XEI).

How do I modify my code so that I create one new row (under the row my loop is currently on) instead of a million columns? My code is as follows:

Sub Commandbutton1()


ThisWorkbook.Sheets("company").Activate


Sheet2.Range("A1:A10000").Select

Selection.Copy


ThisWorkbook.Sheets("Sheet1").Activate


Sheet1.Range("A1:A10000").Value = Sheet2.Range("A1:A10000").Value

Sheet1.Range("B1").Value = "First Name"

Sheet1.Range("C1").Value = "Last Name"

Sheet1.Range("D1").Value = "Email"




Dim i As Integer


i = 1


Do While i <= 100

Dim companyName As String
companyName = Cells(i, 1).Value
firstname = Cells(i, 2).Value
lastname = Cells(i, 3).Value

'Query contacts list
'Find all rows containing companyName
'Find the email in those rows
'Add the email to row i

Dim slot As Integer

slot_email = 4


Dim result As String
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("contact")


Dim isFirstInstance As Integer

isFirstInstance = 0

Dim j As Integer

For j = 1 To sheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count



    Dim k As Integer
    For k = 1 To 39
        Dim cellVal As String
        cellVal = ActiveWorkbook.Worksheets("contact").Cells(j, k).Value
            If cellVal = "" Then
            Exit For
        ElseIf cellVal = companyName Then
            Debug.Print ("For company " & companyName & ", found value on row " & j & " col " & k)
            Cells(i, 4).Value = ActiveWorkbook.Worksheets("contact").Cells(j, 4).Value
            Cells(i, 2).Value = ActiveWorkbook.Worksheets("contact").Cells(j, 2).Value
            Cells(i, 3).Value = ActiveWorkbook.Worksheets("contact").Cells(j, 3).Value

            isFirstInstance = isFirstInstance + 1
                Debug.Print (isFirstInstance & " on column " & k)

            If isFirstInstance > 1 Then
                Debug.Print ("Found a duplicate contact!")

                Dim row As String
                row = i

                Rows(row).Resize(1).Insert

                i = i + 1
            End If

        End If
    Next k
Next j

i = i + 1


Loop



End Sub

Answer：

Sub InsertRowAtSecondLine()
    Dim rowOfInterest As Long
    rowOfInterest = 2
    Cells(rowOfInterest, 1).EntireRow.Insert
End Sub

a
b
c
d

a
<blank row>
b
c
d

Tags: excel-vbaexcel, vba