Selected Answer
Below is the code that will do the job you describe. Install it in a standard code module of your project. That's one which you have to insert, whose default name will be Module1. None of the existing modules is suitable but you can simply drag the TeachExcel module from the attached workbook into your project in the VB Editor's Project Explorer window while both workbooks are open.
Option Explicit
Private Enum Nws ' worksheet navigation
' Variatus @TeachExcel
' 09 Jan 2019
NwsFirstDataRow = 2
NwsProject = 1 ' column with project ID (1 = A)
NwsCompany ' undefined means previous + 1, here it's 2 = B
End Enum
Sub SplitProjectsToRows()
' Variatus @TeachExcel
' 09 Jan 2019
Dim Ws As Worksheet
Dim Sp() As String ' company names
Dim i As Integer ' index to company names
Dim R As Long ' sheet row numbers
' identify the tab to work on:-
' either name the tab as "Projects" or change the name here
' NOTE: The workbook is the active one (the one you last saw)
' which need not necessarily be ThisWorkbook
Set Ws = ActiveWorkbook.Worksheets("Projects")
' screen will not change until all the work is done
Application.ScreenUpdating = False
With Ws
' determine the last used row in the Project column
' then work from the bottom up because row numbers will
' change when new rows are inserted. But working from the
' end leaves original row numbers unchanged.
For R = .Cells(.Rows.Count, NwsProject).End(xlUp).Row To NwsFirstDataRow Step -1
Sp = Split(.Cells(R, NwsCompany).Value, ",")
If UBound(Sp) > 0 Then
For i = 1 To UBound(Sp)
.Rows(R).Copy
.Rows(R + 1).Insert Shift:=xlDown
Next i
Application.CutCopyMode = False
For i = 0 To UBound(Sp)
.Cells(R + i, NwsCompany).Value = Trim(Sp(i))
Next i
End If
' progress report in the StatusBar (left bottom of screen)
' updates every 25 rows
If R Mod 25 = 0 Then
Application.StatusBar = R & " rows to go"
End If
Next R
End With
With Application
.ScreenUpdating = True
.StatusBar = "Done"
End With
End Sub
Please read my comments in the code. They will help you. Note that you can modify the enumeration at the top of the code to specify another first row or other columns for Project ID and Company Name. The column captions are immaterial, and the program will copy all data in each row to all inserted rows.
Note that the company names must be comma delimited. The macro can be modified to use another delimiter. It deals with leading or trailing blank spaces.
Here's a little extra. You may not like to have the project ID repeated in each row. In the attached workbook I have changed the font colour of repetitions to red. If you change the colour to white (background colour) they will become invisible (but you can still see the project number if you click on the cell). This must be done after the code has run. And this is how to do it.
- Select the Project column (all 25,000 rows)
- On the Home tab click Find & Select > GoTo ...
- In the Reference field enter the address of the range you wish to select, e.g. A2:A25000
- Press OK.
- Without changing the selection, select Conditional formatting on the Home tab.
- Select New Rule and Use a formula to determine which cells to format.
- Format values where this formula is true
=A2=A1
where A2 is the cell containing the first project number and A1 is the cell immediately above it.
- Set the Format to the font colour of your sheet's background.
The Project tab shows the result after running the code and applying CF. To repeat, copy the Original to the Project sheet and run the code again, the apply CF as described above.
