I need help to change a Do While Not Loop

[Andries]

Hi

I
I am currently using this code but I need to change it but I don't know how..I am a beginner at this. I don't want to insert the entire row but only range "A:I"


"Do While Not IsEmpty(cell.Value)
If cell.Value > 1 Then
Range(cell.Offset(1), cell.Offset(cell.Value - 1)).EntireRow.Insert
Range(cell, cell.Offset(cell.Value - 1, 1)).EntireRow.FillDown
End If
Set cell = cell.Offset(cell.Value)
Loop"

Thank you
Dries

 

[Andries]

Hi Again

I have info in Column A to I, Column I has a number which is variable. Based on what the value is in column I for example 12. the code must Duplicate this info which is only in column A to I for another 11 times.

This code is working but I don't want to copy the entire row only the info in Columns A to I. The info in Column J and further on must not be duplicated

Set Cell = .Range("I17")
Do While Not IsEmpty(Cell.Value)
If Cell.Value > 1 Then
Range(Cell.Offset(1), Cell.Offset(Cell.Value - 1)).EntireRow.Insert
Range(Cell, Cell.Offset(Cell.Value - 1, 1)).EntireRow.FillDown
End If
Set Cell = Cell.Offset(Cell.Value)
Loop

 

[JoeMo]

Change .EntireRow to
.Resize(, 9)

 

[Andries]

Hi JoeMo

Have I changed this correctly? because instead of copying the info in Columns A to I it copies Info from I to Q

Set Cell = .Range("I17")
Do While Not IsEmpty(Cell.Value)
If Cell.Value > 1 Then
Range(Cell.Offset(1), Cell.Offset(Cell.Value - 1)).Resize(, 9).Insert
Range(Cell, Cell.Offset(Cell.Value - 1, 1)).Resize(, 9).FillDown
End If
Set Cell = Cell.Offset(Cell.Value)
Loop
End With
End Sub

 

[shg]

Another way:

    Dim cell        As Range
 
    Set cell = Range("I17")
 
    Do Until IsEmpty(cell.Value)
        If VarType(cell.Value2) = vbDouble Then
            If cell.Value > 1 Then
                cell.Offset(1).Resize(cell.Value - 1).EntireRow.Range("A1:I1").Insert
                cell.EntireRow.Range("A1:I1").Resize(cell.Value).FillDown
            End If
 
            Set cell = cell.Offset(cell.Value)
        End If
    Loop

 

[JoeMo]

You didn't say where cell was located in your original post so I assumed it was column A. Changes:

Range(cell.Offset(1), cell.Offset(cell.Value - 1)).Offset(0, -8).Resize(, 9).Insert
Range(cell, cell.Offset(cell.Value - 1, 1)).Offset(0, -8).Resize(, 9).FillDown

 

[Andries]

Hi JoeMo

I have tried the code but it appears that there is something wrong. This is my list of info and please see the second table what it should look like.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-1
2	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-2
3	30-May-11	X	MMH211T	C	130	180	414	CLOSED	20	GREEN-1-3
Sheet3

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-1
2	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-2
3	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-3
4	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-4
5	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-5
6	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-6
7	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-7
8	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-8
9	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-9
10	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-10
11	30-May-11	X	DLM501T	A	24	240		O/B	11	GREEN-1-11
12	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-12
13	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-13
14	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-14
15	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-15
16	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-16
17	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-17
18	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-18
19	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-19
20	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-20
21	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-21
22	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-22
23	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-23
24	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-24
25	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-25
26	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-26
27	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-27
28	30-May-11	X	MHC201T	B	30	180	414	CLOSED	17	GREEN-1-28
29	30-May-11	X	MMH211T	C	130	180	414	CLOSED	20	GREEN-1-29
Sheet3

 

[Andries]

Hi Anybody else that can assist...it seems like Joemo is offline and I am desperate

I see that if the values in Column I is less than 11 the code is working fine but if above 11 it is not working correctly

thanks
Dries

 

[shg]

Try this. Note that, consistent with your example, the first cell is I1, not I17.

Sub x()
    Dim cell        As Range
 
    Set cell = Range("I1")
 
    Do Until IsEmpty(cell.Value)
        If VarType(cell.Value2) = vbDouble Then
            If cell.Value > 1 Then
                cell.Offset(1).EntireRow.Range("A1:I1").Resize(cell.Value - 1).Insert Shift:=xlShiftDown
                cell.EntireRow.Range("A1:I1").Resize(cell.Value).FillDown
                Set cell = cell.Offset(cell.Value)
            Else
                Set cell = cell.Offset(1)
            End If
        Else
            Set cell = cell.Offset(1)
        End If
    Loop
End Sub

 

[Andries]

Hi It seems to be working fine but what do I need to change if my data starts in I17?