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
I believe Rows(row).Resize(1).Insert is going to shift your single column down instead of the whole row (for you to then insert the new row of data). I think you want to use: Rows(5).EntireRow.Insert for example and also use Application.CutCopyMode = False so that it doesn’t try to insert your previously copied data
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