Excel / VBA -- Create rows below based on int in abritrary col/row

Question

I am making an Excel sheet for keeping track of courses and its participants.

The format is as such:

01. Place  | Time | Date | Slots
02. SO.com   Now     Now     5
03. SE.com   Soon    Soon    10

And etc.

This list is sent to me with anywhere from 10 to 50 courses at a time, and I want to keep track of the participants for each course in the same file.

So ideally, I want to run a macro that, under the course for SO.com, creates 5 (See Slots) new rows, and then replaces the value 5 with a =COUNTBLANK for the range that was just created, so that the "Slots" value will now show how many free slots there are instead of the total number of slots. Bonus points if anyone can point me to how I can make the macro group the created selection as well.

The macro should loop through the entire worksheet and do the same operation for every course.

The result should look like this:

01. Place | Time | Date | Slots
02. SO.com  Now     Now     5
03. <empty>
04. <empty>
05. <empty>
06. <empty>
07. <empty>
08. SE.com  Soon    Soon    10
09. <empty>
10. <empty>
...

Entering the participants into the Excel field is done through copypasta, as I have a system for mass exporting this information from a different program.

I'm very new at VBA, but below is my initial attempt at starting to construct this code. I cut some code from other parts of the web, did some lookups to MSDN, and guesstimated the rest, and not very surprisingly, it doesn't quite work yet. I get an object required error on the line starting with "Set cellCount = Worksheets [...]" and I don't understand why.

Any input on other parts of the process (if you see that my code is stillborn regardless of the object error, for example) is also appreciated.

Sub insertRowsCourseSpace()

    Dim i&
    Dim cellCount As Integer
    Dim a As Integer

    'Locate the column to look for course space values    
    Dim col_n As Long
        For f = 1 To NumCols
        If Cells(2, f).Value = "Slots" Then col_n = f 'Finding the cell with the given string sets the column number
    Next

    'If cell value is numerical, create rows equal to value
    For i = 1 To NumRows
        If IsNumeric(Worksheets(1).Range(col_n & i).Value) = True Then
            Set cellCount = Worksheets(1).Range(col_n & i).Value
            Set Worksheets(1).Range(col_n & i).Value = "=COUNTBLANK(ActiveCell.Offset(1):ActiveCell(Offset(1 + cellCount))"
            For j = 1 To cellCount
                ActiveCell.Offset(j).EntireRow.Insert
            Next j
    Next i

End Sub

EDIT:

OK, new attempt:

Using this workbook: http://s000.tinyupload.com/?file_id=02770147469124312893

Sub insertRowsCourseSlots()

Dim i&
Dim cellCount As Integer
Dim cellValue As Integer
Dim a As String
Dim b As String

'Locate correct column to look for course slots
'Dim col_n As Long
'
'    For f = 1 To 15 'Course slots won't be located further out than 15 columns, arbitrary value
'    If Cells(2, f).Value = "Antall kursplass" Then col_n = f
'Next

'If cell value is numerical, insert number of rows equal to the cell value
For i = 3 To 400 '400 = Arbitrary number
    If IsNumeric(Sheets("Sheet1").Cells(2, i).Value) = True Then
        cellValue = Sheets("Sheet1").Cells(2, i).Value
        cellCount = cellValue
        a = ActiveCell.Offset(1)
        b = ActiveCell.Offset(1) + CStr(cellCount)
        Set Sheets("Sheet1").Cells(2, i).Value = "=COUNTBLANK(a:b)"
        For j = 1 To cellCount
            ActiveCell.Offset(j).EntireRow.Insert
        Next j
    End If
Next i 
End Sub

This gives me Runtime error '9', subscript out of range, on the line Set Sheets("Sheet1").Cells(2, i).Value = "=COUNTBLANK(a:b)"

If I understand correctly, you receive a list with courses including the amount of slots per course. Then you want to insert that amount of slots as blank rows below each course line? — Jens, Feb 25 '15 at 10:06
Will the layout of the table always be like in the top example? If so there is really no point in searching for the correct column-header, as it'll always be in the same column. — eirikdaude, Feb 25 '15 at 10:11
I believe the cause of your error is the use of the ['Set' keyword](http://stackoverflow.com/q/349613/3725745), which sets a reference to an object. Since integer variables aren't objects you don't need this keyword. The rest of your code others seem to have made some attempt at in their answers. — Aiken, Feb 25 '15 at 12:25

eirikdaude · Accepted Answer · 2015-02-26T10:17:47.850

1

Here is my take on your problem. Please note that you'll probably run into trouble if the data isn't formatted as it seems to be in your top post, or if there e.g. are empty cells in the column describing number of participants.

As to your own code, I didn't look too closely into it, as I found it easier to start from scratch, but from what I saw I'd strongly recommend you to use Option Explicit at the top of your modules, forcing you to declare all your variables. Where are you for instance getting the values for NumCols or NumRows from?

As to why the sub aborts at the line it does, I believe it is because the argument you pass to Worksheets.Range() is not valid.

Sub insertRowsCourseSpace()
  Dim no_to_insert() As Variant, v As Variant, at_row_number As Long, i As Long

  no_to_insert = Range(Worksheets("Sheet1").Range("E2"), Worksheets("Sheet1").Range("E1048576").End(xlUp))
  at_row_number = 2

  For Each v In no_to_insert
    ' Inserts new rows
    Worksheets("Sheet1").Rows(CStr(at_row_number + 1) & ":" & CStr(at_row_number + CLng(v))).Insert shift:=xlDown
    ' Inserts formula
    Worksheets("Sheet1").Range("E" & CStr(at_row_number)).Formula = "=COUNTBLANK(B" & CStr(at_row_number + 1) & ":B" & CStr(at_row_number + CLng(v)) & ")"
    ' Name range
    Worksheets("Sheet1").Range("A2:E2").Offset(at_row_number - 2, 0).Resize(CLng(v) + 1, 5).Name = "Range" & CStr(i)
    i = i + 1
    ' Decides where to insert the new set of rows
    at_row_number = at_row_number + CLng(v) + 1
  Next
  With Worksheets("Sheet1").Range("A1")
    .Value = "01."
    .AutoFill .Resize(at_row_number, 1), xlFillSeries
  End With
End Sub

Updated code:

Sub insertRowsCourseSpace()
  Dim no_to_insert() As Variant, v As Variant, at_row_number As Long, i As Long

  no_to_insert = Range(Worksheets("Sheet1").Range("B3"), Worksheets("Sheet1").Range("B1048576").End(xlUp))
  at_row_number = 3

  For Each v In no_to_insert
    ' Inserts new rows
    Worksheets("Sheet1").Rows(CStr(at_row_number + 1) & ":" & CStr(at_row_number + CLng(v))).Insert shift:=xlDown
    ' Inserts formula
    Worksheets("Sheet1").Range("B" & CStr(at_row_number)).Formula = "=COUNTBLANK(A" & CStr(at_row_number + 1) & ":A" & CStr(at_row_number + CLng(v)) & ")"
    ' Name range
    Worksheets("Sheet1").Range("A3:H3").Offset(at_row_number - 3, 0).Resize(CLng(v) + 1, 8).Name = "Range" & CStr(i)
    i = i + 1
    ' Decides where to insert the new set of rows
    at_row_number = at_row_number + CLng(v) + 1
  Next
  'With Worksheets("Sheet1").Range("A1")
  '  .Value = "01."
  '  .AutoFill .Resize(at_row_number, 1), xlFillSeries
  'End With
End Sub

edited Feb 26 '15 at 10:17

answered Feb 25 '15 at 11:12

eirikdaude

3,106
6
25
50

I can't get your code to work. Debugger says type mismatch on row 11: – Vegard Feb 25 '15 at 11:53
It works for me. Is there something else than the number of open slots in your column E? – eirikdaude Feb 25 '15 at 12:04
There is a column header, similar to how it appears in the example. – Vegard Feb 25 '15 at 12:08
Yeah, that's why it starts in `E2`/row 2. What is the line it stops on? For me line 11 is `Worksheets("Sheet1").Range("E" & CStr(at_row_number)).Formula = "=COUNTBLANK(B" & CStr(at_row_number + 1) & ":B" & CStr(at_row_number + CLng(v)) & ")"` Are you able to post an actual sample workbook somewhere? – eirikdaude Feb 25 '15 at 12:12
http://s000.tinyupload.com/?file_id=02770147469124312893 The formatting isn't the same as in my original post (but the testbook I tried your code was!), this is the production sample layout with bogus data. Sheet 2 contains an estimate of the result (I only formatted the top 3 courses) - the lines that are filled in with Does are just examples of what I would do with the file after the macro has run, and how the COUNTBLANK function needs to play into it all. – Vegard Feb 25 '15 at 12:46
I have a meeting now, but I'll see if I can have a look at it a bit later today. Worst case scenario I'll check back in tomorrow :) – eirikdaude Feb 25 '15 at 12:59
But to answer your previous question, yes, the line you pasted is where it stopped for me too. The sample book I tried the code on was laid out identical to the example in OP. – Vegard Feb 25 '15 at 13:00
Your workbook had two header rows (sort of). I've updated the code, and I now believe that it should do what you want it to. At least it seems to do what you ask for for me. I'll leave in the old code too, for comparison. – eirikdaude Feb 26 '15 at 10:16
That does seem to work for me too, in the testbook. But if the layout changes and I change the corresponding values in your code, from column B to column A, the code breaks: subscript out of range, on the no_to_insert bit. – Vegard Feb 26 '15 at 10:39
If it works, I'd appreciate it if you marked my answer as the solution (there's a checkmark next to the top of the answer). And feel free to contact me again for any further questions. – eirikdaude Feb 26 '15 at 10:40
It should already be marked. And I figured out how to make it work for any column. The only thing I might add, it doesn't perform any inserts after the last-most course line? And lastly, if I were to bring this code to my workplace, would that be permissible to you and if so how do you want me to put the credit? – Vegard Feb 26 '15 at 11:13
No need for any credit, and feel free to use it any way you like. I believe it does insert rows after the final entry, it just doesn't copy the formatting from the row above. If it's just the borders you want, try to add in these two lines after the loop: `Worksheets("Sheet1").Range("A3:H3").Resize(at_row_number - 2, 8).Borders.LineStyle = xlContinuous` and `Worksheets("Sheet1").Range("A3:H3").Resize(at_row_number - 2, 8).Borders.Weight = xlThin` – eirikdaude Feb 26 '15 at 11:25
Partially functional - if the last line has 15 slots, the code formats 17 lines below it. – Vegard Feb 26 '15 at 11:39
Hmm, even with the `-2`? Increase that to `-4`, then, though I'm not sure why the count is off. – eirikdaude Feb 26 '15 at 11:41
Beautiful! I would give you more +'s if I knew how. – Vegard Feb 26 '15 at 11:48
There's an up-arrow next to the arrow too, but I'm not sure if you have enough reputation to use it? ;) – eirikdaude Feb 26 '15 at 11:50

score 0 · Answer 2 · answered Feb 25 '15 at 10:11

May I suggest transferring your data to ms access? Even though what you are asking is easily possible in excel, I don't think it will let you keep track of everything in a handy way.

My suggestion is, create two tables in ms access. One with all your courses, and with all participants, regardless of the course. The you add a reference in the participants table, in which you connect the correct course ID from the first table. Afterwards, you can easily run a query to get all your data. If you want to, you can always export your data to excel.

Should you really want to do it in excel for whatever reason, leave a comment and I'll help you out.

MS Access is unfortunately not an option - believe me, my first thought about this problem was to export it to a database. The powers that be have decided that I must use Excel. — Vegard, Feb 25 '15 at 11:26

Excel / VBA -- Create rows below based on int in abritrary col/row

2 Answers2