Trying Post Document

[gzell]

I am researching my Great Great Grandfathers time during the Civil War. What started to be a simple Excel file has grown to a large file, 25000+ rows. Not what I planned for but the further I got in the research the more I expanded to included all members of his units. I am new to VBA and have am trying to learn the basics to complete this document. If this request is not allowed please let me know.

Flow
Search Column D for Cell "Rank:"
When found, insert row below this Cell
Also, insert text "Age:" in column D in new row
Insert row below Cell with "Age"
insert "Residence:" in column D of this row
Loop through Range of Spreadsheet
Repeat
Until end of document
End

This is a code I found online, to enter one line but it does not work as expected. Any help would be greatly appreciated.

Sub Insert_Row_Below_Blank()
Dim i As Range
Dim cell As Range
Set i = Range("D1:D25391")
For Each cell In i.Cells
If cell.Value = "Rank:" Then
cell.Offset(1).EntireRow.Insert

End If
Next
End Sub







Excel 2016 (Windows) 32 bit

	A	B	C	D	E
1	Document ID	Person_ID	Name	Details	Notes
2			xxxxxx
3			xxxxxx	Service:
4			xxxxxx	Location:
5			xxxxxx	Regiment:
6			xxxxxx	Function:
7			xxxxxx	Company:
8			xxxxxx	Rank:
9			xxxxxx	Enrolled:
10			xxxxxx	Date:
11			xxxxxx	Enlisted:
12			xxxxxx	Date:
13			xxxxxx	Detail:
14			xxxxxx	Captured:
15			xxxxxx	Prisoner:
16			xxxxxx	Died:
17			xxxxxx	Cause:
18			xxxxxx	Buried:
19			mmmm
20			mmmm	Service:
21			mmmm	Location:
22			mmmm	Regiment:
23			mmmm	Function:
24			mmmm	Company:
25			mmmm	Rank:
26			mmmm	Enrolled:
27			mmmm	Date:
28			mmmm	Enlisted:
29			mmmm	Date:
30			mmmm	Detail:
31			mmmm	Captured:
32			mmmm	Prisoner:
33			mmmm	Exchanged:
34			mmmm	Location:
35			mmmm	Battle:
36			mmmm	Date:
37			mmmm	Detail:
38			mmmm	Location:
39			mmmm	Date:
40			mmmm	Captured:
41			mmmm	Forwarded:
42			mmmm	Date:
43			mmmm	Date:
44			mmmm	Location
45			mmmm	Died:
46			mmmm	Cause:
47			mmmm	Buried:

<tbody>
</tbody>

Sheet1​

 

[Michael M]

Try this...UNTESTED

Sub MM1()
Dim r As Long, lr As Long
lr = Cells(Rows.Count, "D").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("D" & r).Value = "Rank:" Then
        Rows(r + 1).Resize(2).Insert
        Range("D" & r + 1).Value = "Age:"
        Range("D" & r + 2).Value = "Residence:"
    End If
Next r
End Sub

 

[gzell]

Thanks for the response but it isn't working.

 

[Joe4]

When looping through a range and either inserting or deleting rows, it is always better to work from the bottom up (like Michael shows). Otherwise, you are changing the size of the range that you haven't checked yet, and some rows could get missed.

Thanks for the response but it isn't working.

Please explain exactly how it is not working. What is happening?

 

[gzell]

It doesn't do anything. I have created a new test sheet and nothing happens. I am searching to make sure it isn't the worksheet. Thanks for the response.

 

[Joe4]

Two things to check:

1. Are these values in column D?
2. Is the value you are looking for EXACTLY equal to "Rank:"?
If there is even an extra space anywhere in there, it won't match, and the code won't do anything.

An easy way to check is to identify some cell that you think matches. Let's say it is D10.
Then enter the following in any blank cell:
=D10="Rank:"
If that returns FALSE, then they do not really match, there is something extra in there.

 

[Fluff]

How about

Sub gzell()
   Dim Ar As Areas
   Dim Rng As Range
   With Range("D2", Range("D" & Rows.count).End(xlUp))
      .Replace "Rank:", "=xxxRank", xlPart, , False, , False, False
      Set Ar = .SpecialCells(xlFormulas, xlErrors).Areas
      .Replace "=xxxRank", "Rank:", xlPart, , False, , False, False
   End With
   For Each Rng In Ar
      Rng.Offset(1).EntireRow.Resize(2).Insert
      Rng.Offset(1).Resize(2).Value = Application.Transpose(Array("Age:", "Residence:"))
   Next Rng
End Sub

 

[gzell]

Thanks. I did a quick run on a practice sheet and it looks good. I will do a thorough run tonight when i get back home.

thanks to both of you for the response and help. I greatly appreciate your help.

Glen

 

[Fluff]

You're welcome, let us know how it goes.

 

[gzell]

It works perfect until it reaches row 96 it then goes to End Sub. I stepped through the process in debug mode and Row 97 and placing Residence in the cell it went to End. Any thoughts?