Mar 10 2022 10:30 AM
Hello,
Thank you for reading my question. Could you please help me with this task?
I have to do a repetitive task with a quite a large excel worksheet (or table). I am wondering if there is way for me to do all this task at once or to save as much time as possible.
I want to insert (create/add) new rows under every row that meets a certain condition. To better understand what I am trying to do, please see the example below.
Suppose I have following worksheet
A | B | C | |
1 | chapter 1 | ||
2 | length | 15 pages | |
3 | things to try | p10-11 | |
4 | things to try | p13 | |
5 | chapter 2 | ||
6 | length | 5 pages | |
7 | things to try | p16 | |
8 | chapter 3 | ||
9 | length | 15 pages | |
10 | chapter 4 | ||
11 | length | 20 pages | |
12 | things to try | p43 |
I want to insert 2 new rows under every "chapter", that is under every row where there is an entry in column A. After that I want to add in each of the new rows a new entry, "word count" and "date started" respectively, in column B. The desired end result should look like the table below.
A | B | C | |
1 | chapter 1 | ||
word count | |||
date started | |||
2 | length | 15 pages | |
3 | things to try | p10-11 | |
4 | things to try | p13 | |
5 | chapter 2 | ||
word count | |||
date started | |||
6 | length | 5 pages | |
7 | things to try | p16 | |
8 | chapter 3 | ||
word count | |||
date started | |||
9 | length | 15 pages | |
10 | chapter 4 | ||
word count | |||
date started | |||
11 | length | 20 pages | |
12 | things to try | p43 |
Thank you so much for your help!
Regards,
Kang
Mar 10 2022 11:08 AM
Run this macro:
Sub InsertRows()
Dim rng As Range
Dim r As Long
Application.ScreenUpdating = False
Set rng = Range("B:B").Find(What:="chapter*", LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False)
If Not rng Is Nothing Then
Do
r = rng.Row
rng.Offset(1).Resize(2).EntireRow.Insert
rng.Offset(1, 1).Value = "word count"
rng.Offset(2, 1).Value = "date started"
Set rng = Range("B:B").Find(What:="chapter*", After:=rng, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False)
If rng Is Nothing Then Exit Do
Loop Until rng.Row > r
End If
Application.ScreenUpdating = True
End Sub
Mar 10 2022 11:14 AM
SolutionSub insertrow()
Dim i As Integer
Dim j As Integer
For i = 1 To 1000
j = InStr(1, Cells(i, 1), "chapter", vbTextCompare)
If j = 1 Then
Cells(i + 1, 1).EntireRow.Insert
Cells(i + 2, 1).EntireRow.Insert
Cells(i + 1, 2).Value = "word count"
Cells(i + 2, 2).Value = "date started"
i = i + 2
Else
End If
Next i
End Sub
Maybe with these lines of code. Click the button in cell E1 in the attached file to start the macro.
Mar 10 2022 12:05 PM
Mar 10 2022 12:09 PM