Copying and Pasting through Ranges of Varying Lengths

[washj]

Hello All,

I am trying to get Excel to copy and paste codes into all of the cells adjacent to the university names under that code (see the table below for an example. I want the macro to stop pasting when it reaches the next code (cell B11 in the table below) . I then want Excel to copy that new code and repeat the pasting process. I want this process to continue until the macro has processed all of the data in column B.

I wrote up the logical steps the code needs to take, but I'm not sure how to turn them into VBA code. I've done some YouTube and Google searches, but no luck. I have to copy and paste these codes over 100,000 rows of data, so any help would be highly appreciated.

	A	B
1		01.0000) Agriculture, General
2	01.0000) Agriculture, General	Fort Hays State University
3	01.0000) Agriculture, General	Missouri State University-Springfield
4	01.0000) Agriculture, General	Northwest Missouri State University
5	01.0000) Agriculture, General	Oregon State University
6	01.0000) Agriculture, General	Stephen F Austin State University
7	01.0000) Agriculture, General	Tarleton State University
8	01.0000) Agriculture, General	Tennessee State University
9	01.0000) Agriculture, General	The University of Tennessee-Martin
10	01.0000) Agriculture, General	University of Nebraska-Lincoln
11		01.0101) Agricultural Business and Management, General
12		Southern Arkansas University Main Campus
13		Texas A & M University-College Station
14		Utah State University
15		01.0102) Agribusiness/Agricultural Business Operations
16		Colorado State University-Fort Collins
17		Pennsylvania State University-World Campus
18		Texas A & M University-College Station

[SamT]

It would help to see your logical steps.

It would be easiest to place the results on another sheet, or at least to different columns.

[SamT]

Option Explicit

Sub VBAX_SamT()
Dim Rw As Long
Dim Course As String

For Rw = 1 To Cells(Rows.Count, "B").End(xlUp).Row
  With Cells(Rw, "B")
    If .Font.Bold And InStr(.Value, ")") Then
      Course = .Value
    Else
      .Offset(, 1) = Course
      .Offset(, 2) = .Value
    End If
  End With
Next Rw
End Sub

[washj]

It works perfectly, thanks!