Insert Rows

[Lande]

I would ultimately like column A to repeat the values 1-20. Right now, I have incomplete data. For example, my column A might look like:

1
2
3
8
9
16
17
1
6
1
2
3
5
6
9
10
11
20

Is there a macro to insert rows so that column A consistently has rows for each number 1-20? If this helps, there will always be a "1", but not necessarily an 20. So I will also want the last "1" to be the start of the final set of 1-20.

Thank you in advance for your help!

[rory]

Try this:
[VBA]Sub addRows()
Dim lngIndex As Long, lngRows As Long, lngCounter As Long
Application.screenupdating = False
lngRows = Cells(Rows.Count, "A").End(xlUp).Row
Do While lngRows > 0
For lngCounter = 20 To 1 Step -1
If Cells(lngRows, "A") <> lngCounter Then
Cells(lngRows + 1, "A").EntireRow.Insert
Cells(lngRows + 1, "A").Value = lngCounter
Else
lngRows = lngRows - 1
End If
Next lngCounter
Loop
application.screenupdating = true
End Sub
[/VBA]

[Bob Phillips]

Another way

[vba]

Public Sub ProcessData()
Dim NumOnes As Long
Dim i As Long

NumOnes = Application.CountIf(Columns(1), 1)
Range("A1").Value = 1
Range("A2:A20").Formula = "=A1+1"
Range("A1:A20").Value = Range("A1:A20").Value
For i = 2 To NumOnes
Range("A1:A20").Copy Range("A" & 20 * (i - 1) + 1)
Next i
End Sub
[/vba]

[Lande]

Rory- That code is either taking a very long time or freezing up excel (I'm assuming the former). Is this due to the looping procedure (I am not very comfortable with looping)?

[Lande]

XLD - Your code does a good job of copying the appropriate nubmer of 1-20 sets, however, I need rows inserted where the 1-20 is missing, so that all of the data in the row stays together, including with its appropriate 1-20 value.

Basically the 1-20 value is a just a code and each row is a characteristic of a case. There will be 20 of these rows, or characteristics (labeled with the codes 1-20 as mentioned before) for each case. Currently, no cases have all 20 characteristics, but I would like to make a row for each of the 20 characteristics anyways.

Rory - After finally letting your code run over a long lunch, I came back to it erroring out when it reached the actual data because it started in row 65433 and when it got to the data, there was no longer space to insert rows. Is there a way to get it to start at the last actual data?

Thanks!

[lucas]

Hi Lande,
I ran both of them on some sample data. Rory's will not work correctly if there are blanks in Column A. Other than that they both ran fine for me as I said on sample data. You might need to post what you are testing on.

[Bob Phillips]

In that case, Rory's method is the way to go.

I have just tried it, and it woks fine for me.

[otto]

[VBA]

Sub Insert_rows()
'
'
Dim cur_row As Long
cur_row = 1
'
Do While Range("A" & cur_row).Value <> ""
Do While Range("A" & cur_row).Value < 20

If Range("A" & cur_row).Value < 1 Then
MsgBox "value in A" & cur_row & " less than 1"
Exit Sub
End If

If Range("A" & cur_row).Value > 20 Then
MsgBox "value in A" & cur_row & " greater than 20"
Exit Sub
End If

If (Range("A" & cur_row).Value) = Range("A" & cur_row +
1).Value Then
MsgBox "duplicate numbers not allowed"
Exit Sub
End If

If Range("A" & cur_row).Value > Range("A" & cur_row + 1).Value Then
If Range("A" & cur_row + 1).Value <> 1 Then
MsgBox "next sequence must start with 1"
Exit Sub
End If
End If

If (Range("A" & cur_row).Value + 1) = Range("A" & cur_row + 1).Value Then
cur_row = cur_row + 1
End If

ElseIf Range("A" & cur_row).Value <> Range("A" & cur_row + 1).Value Then
Range("A" & cur_row + 1).Select
Selection.Insert Shift:=xlDown
Range("A" & cur_row + 1).Value = (Range("A" & cur_row).Value + 1)
Range("B" & cur_row + 1).Value = "generated"

cur_row = cur_row + 1

End If

Loop

cur_row = cur_row + 1


Loop

End Sub
[/VBA]

here is the test result:

1

1223384generated95generated166generated177generated1869110generated211generated312generated513generated614generated915generated1016111720

18generated19generated20generated12generated3generated4generated5generated67generated8generated9generated10generated11generated12generated13generated14generated15generated16generated17generated18generated19generated20generated1234generated567generated8generated9101112generated13generated14generated15generated16generated17generated18generated19generated20

[otto]

sorry, the test results were colums A and B, they did not copy very well!

[Lande]

My problem with Rory's solution was that I had a string in row 1 and was wanting to start in Row 2. Once I removed that first row, it worked perfectly!

As for otto's solution, I got a compile error at the "elseIf" line. However, I did get the other one to work, so didn't try figuring it out.

Thank you!!!

[figment]

this looked like a fun problem so i submit my solution

[VBA]Sub testing()
Dim curcount As Long, mult As Long, headrowlength As Byte
headrowlength = 1
mult = 0
curcount = 1
While Range("a" & mult * 20 + curcount + headrowlength) <> ""
If Range("a" & mult * 20 + curcount + headrowlength) > curcount Then
Range("a" & mult * 20 + curcount + headrowlength).EntireRow.Insert
ElseIf Range("a" & mult * 20 + curcount + headrowlength) < curcount Then
While curcount < 21
Range("a" & mult * 20 + curcount + headrowlength).EntireRow.Insert
curcount = curcount + 1
Wend
End If
curcount = curcount + 1
If curcount > 20 Then
mult = mult + 1
curcount = 1
End If
Wend
End Sub[/VBA]

[otto]

Sorry, the 'end if' above the 'elseif' does not belong there. I must have fumble fingered the code after testing...which I should not have done.

Otto

[Lande]

Figment - Your solution worked well. The only thing is that in the new row, I also need to new number (so 1-20 is listed)

[figment]

[vba]Sub testing()
Dim curcount As Long, mult As Long, headrowlength As Byte
headrowlength = 1
mult = 0
curcount = 1
While Range("a" & mult * 20 + curcount + headrowlength) <> ""
If Range("a" & mult * 20 + curcount + headrowlength) > curcount Then
Range("a" & mult * 20 + curcount + headrowlength).EntireRow.Insert
Range("a" & mult * 20 + curcount + headrowlength)=curcount
ElseIf Range("a" & mult * 20 + curcount + headrowlength) < curcount Then
While curcount < 21
Range("a" & mult * 20 + curcount + headrowlength).EntireRow.Insert
Range("a" & mult * 20 + curcount + headrowlength)=curcount
curcount = curcount + 1
Wend
End If
curcount = curcount + 1
If curcount > 20 Then
mult = mult + 1
curcount = 1
End If
Wend
End Sub[/vba]

[mfegyver]

i have a similar problem ... but try using 2 vectors, one A(20) read your data, and other, starts from 1 to 20. then, for each number in A, B(A(i)) = 0. at this point, you will remain with B(i)<>0 for the missing values at A. (tell me if I understood your problem correctly...)
[VBA]Option Explicit
Global n
Global B(), A()
Sub corretor()
Dim i, j, cl As Integer
'read vetor
n = 20
ReDim Preserve A(n), B(n)
cl = 1
Do While Cells(cl, 1) <> 0
cl = cl + 1
Loop
For i = 1 To cl
A(i) = Cells(i, 1)
B(i) = i
Next i
For i = cl To n
A(i) = i
B(i) = i
Next i
'END read vetor
' ***** ******
For i = 1 To n
B(A(i)) = 0
Next i
For i = 1 To n
A(B(i)) = 0
Cells(i, 40) = B(i)
Next i
For i = 1 To n
If A(i) = 0 Then
For j = 1 To n
If B(j) > 0 Then
A(i) = B(j)
B(j) = 0
GoTo 30
End If
Next j
30
End If
Next i
'***** *****
'complete vetor
For i = 1 To n
If A(i) <> 0 Then
For j = 1 To n
If B(j) <> 0 Then
A(i) = B(j)
End If
Next j
End If
Next i
'complete vetor

For i = 1 To n
Cells(i, 1) = A(i)
Cells(i, 40) = B(i)
Next i
'END vetor
End Sub

[/VBA]
greetings
marcelo

[mfegyver]

dear masters, my problem is to change the repetitive value for 1 to n in a vector (this case n=20) beggining with any sequency.
my code doesn?t 100% time... please I beg your help:[vba]Option Explicit
Global n
Global G(), H()
Sub corretor()
Dim i, j, falta As Integer
'read vetor
n = Cells(14, 2)
ReDim Preserve H(n), G(n)
For i = 1 To n
H(i) = Cells(14+i, 8)
G(i) = i
Next i
'END read vetor
' ***** ******
For i = 1 To n
G(H(i)) = 0
Next i
For i = 1 To n
H(G(i)) = 0
Cells(14 + i, 30) = G(i)
Next i
For i = 1 To n
If H(i) = 0 Then
For j = 1 To n
If G(j) > 0 Then
H(i) = G(j)
G(j) = 0
GoTo 30
End If
Next j
30
End If
Next i
'***** *****
'imprime vetor
For i = 1 To n
Cells(14 + i, 8) = H(i)
Cells(14 + i, 31) = G(i)
Next i
'FIM imprime vetor
End Sub
[/vba] starting with
121551684719101118581316317209
it must be runned several times until it reach correctly a valid sequence!

[figment]

give this a go
[VBA]Sub corretor()
Dim i As Long, doagain As Boolean
n = Cells(14, 2)
ReDim Preserve H(n), G(n)
doagain = True
While doagain = True
doagain = False
For i = 1 To n
H(i) = Cells(14 + i, 8)
G(i) = i
Next

For i = 1 To n
If H(i) <= n Then G(H(i)) = 0
Next

For i = 1 To n
H(G(i)) = 0
Cells(14 + i, 30) = G(i)
Next

For i = 1 To n
If H(i) = 0 Then
H(i) = i
doagain = True
G(i) = 0
End If
Cells(14 + i, 8) = H(i)
Next
Wend
End Sub[/VBA]

[mfegyver]

yehh... that?s one solution... many thanks .

now it?s working good. (slowly due to my not charming solution, but it works. the incoming instances will be for n=1000 - I?m screwed ...).
This was part of a bigger heuristic - called scatter search.

Now, When I try to run togheter with another function, states an error "out of stack space" . Do someone knows what it is? is this memory overflow? and what is the solution?
many thanks
greeting
marcelo