VBA Script to Fill Cell into List Below and Repeat

Question

I have a spreadsheet that list a Case Manager and then list the students below it. Then it lists another Case Manager and students below it. I want to copy the Case Manager Name from the top of each list to the end of the row of respective students underneath, repeating with each Case Manager until I get to the end of my sheet. The number of Case Managers and students can vary.

I have the following code to do the first Case Manager but not sure how to loop it of if there is a better solution. I want all the data to stay in the original spot.

Original Source: (Imported Text File) enter image description here

Modified Source: (After Macro is Run) enter image description here

Sub CMWizard()
    Dim CMName As String
    Dim StopRow As Long
    Dim r As Long

    CMName = Range("A1").Value  'Get the Case Manager Name.
    StopRow = Range("B2").End(xlDown).Row  'Get first blank cell in Column B.

    For r = 2 To StopRow  'Start at Row 2 and continue until you reach the StopRow.
        Cells(r, 6).Value = CMName  'Set every cell from Row 2 in Column F (6) to the Case Manager Name.
End Sub

I think I am confused. Can you give an example? Also to find the last row, you may want to use [THIS](http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba) — Siddharth Rout, Nov 22 '13 at 17:27
I can't the data is confidential... I could create a mock-up if the explanation above is still confusing. — Justin_DavieHigh, Nov 22 '13 at 18:08
Yes a mockup will be good because I will ask you less questions then :P — Siddharth Rout, Nov 22 '13 at 18:09
That is really close, but I am not sure my mock up was as specific as it should have been... I apologize. I have updated it and this is more what I need. — Justin_DavieHigh, Nov 22 '13 at 19:20

score 0 · Answer 1 · answered Nov 22 '13 at 16:54

0

i think you are just missing an next

    Sub CMWizard()
Dim CMName As String
Dim StopRow As Long
Dim r As Long

CMName = Range("A1").Value  'Get the Case Manager Name.
StopRow = Range("B2").End(xlDown).Row  'Get first blank cell in Column B.

For r = 2 To StopRow  'Start at Row 2 and continue until you reach the StopRow.
    Cells(r, 6).Value = CMName  'Set every cell from Row 2 in Column F (6) to the Case Manager Name.
Next

End Sub

just be aware that StopRow = Range("B2").End(xlDown).Row will return last row in worksheet if there are just empty cells below ("B2")

Hope it helps

answered Nov 22 '13 at 16:54

bto.rdz

6,636
4
35
52

No... it still just fills in the first set, even with Next in place. – Justin_DavieHigh Nov 22 '13 at 17:07
How can I get it to loop through each set of students and use the cell at the top of each list as the Case Manager Name that I want to fill? – Justin_DavieHigh Nov 22 '13 at 17:08

Siddharth Rout · Accepted Answer · 2013-11-22T19:32:42.703

Let's say your Excel file looks like this

enter image description here

Paste this code in a module. I have commented the code so that you will not have a problem understanding it.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long, LRow As Long, R As Long
    Dim CM As String
    Dim delRng As Range

    Application.ScreenUpdating = False

    '~~> Replace Sheet 1 with the relevant sheet name
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Get last row of Col A
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Loop through cells in Col A
        For i = 1 To LRow
            '~~> Check if the cell contains "Case Manager"
            If InStr(1, .Cells(i, 1).Value, "Case Manager", vbTextCompare) Then
                '~~> Store the Case manager's name in a variable
                CM = .Cells(i, 1).Value
                '~~> Store the row numbers which have "Case Manager"
                '~~> We will delete it later
                If delRng Is Nothing Then
                    Set delRng = .Rows(i)
                Else
                    Set delRng = Union(delRng, .Rows(i))
                End If
            Else
                '~~> Store the Case manager in Col F
                .Cells(i, 6).Value = CM
            End If
        Next i
    End With

    '~~> Delete the rows which have "Case Manager"
    If Not delRng Is Nothing Then delRng.Delete

    Application.ScreenUpdating = True
End Sub

Output

enter image description here

VBA Script to Fill Cell into List Below and Repeat

2 Answers2