Hi Sir,

i am trying to extract data from a cell and then return the data into
designated cell. i try to return the data into the next row of cell by
trying to offset to the next row but unsuccessful. See my example,

The problem is: the loop thing still works except that it does not go to the
next empty row/cell for me. it keep on loop at Row1 and non-stop. Where
should i put my Exit Loop if i want it to end after the macro detect no more
data? Pls advise.


Example:

Sub( )

Range("A1").Select
i = ActiveCell.Offset(1, 0).Select

Do Until i = ""

'Line Number
Cells(i, 3).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-2],2,1)=""0"",TRIM(MID(R[5]C[-2],2,2))*1,""Z"")"

'Quantity
Cells(i, 4).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-3],2,1)=""0"",TRIM(MID(R[5]C[-3],48,7))*1,""Z"")"

'Purchase Order
Cells(i, 5).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-4],2,1)=""0"",TRIM(MID(R[5]C[-4],5,7))*1,""Z"")"

'Acknowledgement Status
Cells(i, 6).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-5],2,1)=""0"",TRIM(MID(R[5]C[-5],46,1)),""Z"")"

'Part No
Cells(i, 7).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[1]C[-6],2,4)=""PODT"",TRIM(MID(R[1]C[-6],10,29)),""Z"")"

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Delete for Next PN
Range("A1:A26").Select
Range("A26").Activate
Selection.Delete Shift:=xlUp

Loop

End Sub( )

Hi Junior,

Try,

Sub Test2()
Dim rng As Range
Dim rcell As Range

Set rng = Range(Cells(1, "A"), Cells(1, "A").End(xlDown))

For Each rcell In rng.Cells

'Line Number
rcell(1, 3).FormulaR1C1 = _
"=IF(MID(R[5]C[-2],2,1)=""0""," _
& "TRIM(MID(R[5]C[-2],2,2))*1,""Z"")"

'Quantity
rcell(1, 4).FormulaR1C1 = _
"=IF(MID(R[5]C[-3],2,1)=""0""," _
& "TRIM(MID(R[5]C[-3],48,7))*1,""Z"")"

'Purchase Order
rcell(1, 5).FormulaR1C1 = _
"=IF(MID(R[5]C[-4],2,1)=""0""," _
& "TRIM(MID(R[5]C[-4],5,7))*1,""Z"")"

'Acknowledgement Status
rcell(1, 6).FormulaR1C1 = _
"=IF(MID(R[5]C[-5],2,1)=""0""," _
& "TRIM(MID(R[5]C[-5],46,1)),""Z"")"

'Part No
rcell(1, 7).FormulaR1C1 = _
"=IF(MID(R[1]C[-6],2,4)=""PODT""," _
& "TRIM(MID(R[1]C[-6],10,29)),""Z"")"
Next rcell

With rng.Resize(, 7)
.Value = .Value
End With

'Delete for Next PN
Range("A1:A26").Delete Shift:=xlUp

End Sub

---
Regards,
Norman



"Junior728" wrote in message
...
Hi Sir,

i am trying to extract data from a cell and then return the data into
designated cell. i try to return the data into the next row of cell by
trying to offset to the next row but unsuccessful. See my example,

The problem is: the loop thing still works except that it does not go to
the
next empty row/cell for me. it keep on loop at Row1 and non-stop. Where
should i put my Exit Loop if i want it to end after the macro detect no
more
data? Pls advise.


Example:

Sub( )

Range("A1").Select
i = ActiveCell.Offset(1, 0).Select

Do Until i = ""

'Line Number
Cells(i, 3).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-2],2,1)=""0"",TRIM(MID(R[5]C[-2],2,2))*1,""Z"")"

'Quantity
Cells(i, 4).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-3],2,1)=""0"",TRIM(MID(R[5]C[-3],48,7))*1,""Z"")"

'Purchase Order
Cells(i, 5).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-4],2,1)=""0"",TRIM(MID(R[5]C[-4],5,7))*1,""Z"")"

'Acknowledgement Status
Cells(i, 6).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-5],2,1)=""0"",TRIM(MID(R[5]C[-5],46,1)),""Z"")"

'Part No
Cells(i, 7).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[1]C[-6],2,4)=""PODT"",TRIM(MID(R[1]C[-6],10,29)),""Z"")"

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Delete for Next PN
Range("A1:A26").Select
Range("A26").Activate
Selection.Delete Shift:=xlUp

Loop

End Sub( )

Hi Norman,

Thanks for your help. i tried but still not work. For the RAnge("A1:A26") is
actually the data array where i extract the info and return in RCell. and i
think the rng variable is the cell that i wish to repeat for row C1 to until
end of data array or empty cells. The A1:A26 is row of data array and i
delete row to bring up(selection up) the next set of data down the sheet.

by the way, what does the function: .End(xlDown) do? Does it bring the Cell
from C1 to C2, C3...C4..and so on(data return to same column(C), but go to
the next new row?

My Amendments(but not sure if it is correct):

Dim rcell As Range

'Change in Row Number
Set rcell = Range(Cells(1, "C"), Cells(1, "C").End(xlDown))

Set rng.Cells = Range("A1:A26")


For Each rng.Cells In rcell
'Line Number
rcell(1, 3).FormulaR1C1 = _
"=IF(MID(R[5]C[-2],2,1)=""0""," _
& "TRIM(MID(R[5]C[-2],2,2))*1,""Z"")"

'Quantity
rcell(1, 4).FormulaR1C1 = _
"=IF(MID(R[5]C[-3],2,1)=""0""," _
& "TRIM(MID(R[5]C[-3],48,7))*1,""Z"")"

'Purchase Order
rcell(1, 5).FormulaR1C1 = _
"=IF(MID(R[5]C[-4],2,1)=""0""," _
& "TRIM(MID(R[5]C[-4],5,7))*1,""Z"")"

'Acknowledgement Status
rcell(1, 6).FormulaR1C1 = _
"=IF(MID(R[5]C[-5],2,1)=""0""," _
& "TRIM(MID(R[5]C[-5],46,1)),""Z"")"

'Part No
rcell(1, 7).FormulaR1C1 = _
"=IF(MID(R[1]C[-6],2,4)=""PODT""," _
& "TRIM(MID(R[1]C[-6],10,29)),""Z"")"

With rng.Resize(, 7)
..Value = .Value
End With

'Delete for Next PN
Range("A1:A26").Delete Shift:=xlUp

Next rcell




"Norman Jones" wrote:

Hi Junior,

Try,

Sub Test2()
Dim rng As Range
Dim rcell As Range

Set rng = Range(Cells(1, "A"), Cells(1, "A").End(xlDown))

For Each rcell In rng.Cells

'Line Number
rcell(1, 3).FormulaR1C1 = _
"=IF(MID(R[5]C[-2],2,1)=""0""," _
& "TRIM(MID(R[5]C[-2],2,2))*1,""Z"")"

'Quantity
rcell(1, 4).FormulaR1C1 = _
"=IF(MID(R[5]C[-3],2,1)=""0""," _
& "TRIM(MID(R[5]C[-3],48,7))*1,""Z"")"

'Purchase Order
rcell(1, 5).FormulaR1C1 = _
"=IF(MID(R[5]C[-4],2,1)=""0""," _
& "TRIM(MID(R[5]C[-4],5,7))*1,""Z"")"

'Acknowledgement Status
rcell(1, 6).FormulaR1C1 = _
"=IF(MID(R[5]C[-5],2,1)=""0""," _
& "TRIM(MID(R[5]C[-5],46,1)),""Z"")"

'Part No
rcell(1, 7).FormulaR1C1 = _
"=IF(MID(R[1]C[-6],2,4)=""PODT""," _
& "TRIM(MID(R[1]C[-6],10,29)),""Z"")"
Next rcell

With rng.Resize(, 7)
.Value = .Value
End With

'Delete for Next PN
Range("A1:A26").Delete Shift:=xlUp

End Sub

---
Regards,
Norman



"Junior728" wrote in message
...
Hi Sir,

i am trying to extract data from a cell and then return the data into
designated cell. i try to return the data into the next row of cell by
trying to offset to the next row but unsuccessful. See my example,

The problem is: the loop thing still works except that it does not go to
the
next empty row/cell for me. it keep on loop at Row1 and non-stop. Where
should i put my Exit Loop if i want it to end after the macro detect no
more
data? Pls advise.


Example:

Sub( )

Range("A1").Select
i = ActiveCell.Offset(1, 0).Select

Do Until i = ""

'Line Number
Cells(i, 3).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-2],2,1)=""0"",TRIM(MID(R[5]C[-2],2,2))*1,""Z"")"

'Quantity
Cells(i, 4).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-3],2,1)=""0"",TRIM(MID(R[5]C[-3],48,7))*1,""Z"")"

'Purchase Order
Cells(i, 5).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-4],2,1)=""0"",TRIM(MID(R[5]C[-4],5,7))*1,""Z"")"

'Acknowledgement Status
Cells(i, 6).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[5]C[-5],2,1)=""0"",TRIM(MID(R[5]C[-5],46,1)),""Z"")"

'Part No
Cells(i, 7).Select
ActiveCell.FormulaR1C1 = _
"=IF(MID(R[1]C[-6],2,4)=""PODT"",TRIM(MID(R[1]C[-6],10,29)),""Z"")"

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Delete for Next PN
Range("A1:A26").Select
Range("A26").Activate
Selection.Delete Shift:=xlUp

Loop

End Sub( )