PDA

View Full Version : Solved: VBA to assign positions for outputs



copyt
04-16-2012, 06:43 AM
Hello all, I have a code to analyze my data according to a certain formular. The outputs will be added to Sheets1/Column A/last row. My problem is the outputs are only added to range A1. Can anybody suggest me a solution for this problem? Any help would be appreciated. :help

Sub Part03()

Application.ScreenUpdating = False
Worksheets("Precursor_ions").Activate
Dim finalrow As Long, _
i As Long
Dim lngPasteRow As Long

finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If Not Cells(i, 3) = "" Then
If ((Cells(i, 3) * Cells(i, 1)) - (Cells(i, 3) * 1.007825)) > 0 Then

On Error Resume Next
lngPasteRow = Sheets("sheet1").Range("A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

On Error GoTo 0

If lngPasteRow = 0 Then
lngPasteRow = 1
End If

Sheets("sheet1").Range("A" & lngPasteRow) = ((Cells(i, 3) * Cells(i, 1)) - (Cells(i, 3) * 1.007825))
End If
End If
Next i

End Sub

Bob Phillips
04-16-2012, 07:09 AM
Maybe


Sub Part03()

Application.ScreenUpdating = False
Worksheets("Precursor_ions").Activate
Dim finalrow As Long, _
i As Long
Dim lngPasteRow As Long

finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If Not Cells(i, 3) = "" Then
If ((Cells(i, 3) * Cells(i, 1)) - (Cells(i, 3) * 1.007825)) > 0 Then

On Error Resume Next
lngPasteRow = Sheets("sheet1").Range("A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

On Error Goto 0

lngPasteRow = lngPasteRow + 1
End If

Sheets("sheet1").Range("A" & lngPasteRow) = ((Cells(i, 3) * Cells(i, 1)) - (Cells(i, 3) * 1.007825))
End If
End If
Next i
End Sub

copyt
04-16-2012, 07:30 AM
@ xld (http://www.vbaexpress.com/forum/member.php?u=2139)

Thank you very much :bow::bow::bow::bow::bow::bow:

copyt
04-16-2012, 09:13 AM
Could you please tell me one more thing? Can the output start from A4?

Bob Phillips
04-16-2012, 11:27 AM
Sub Part03()

Application.ScreenUpdating = False
Worksheets("Precursor_ions").Activate
Dim finalrow As Long, _
i As Long
Dim lngPasteRow As Long

finalrow = Cells(Rows.Count, 1).End(xlUp).Row
lngPasteRow = 3
For i = 1 To finalrow
If Not Cells(i, 3) = "" Then
If ((Cells(i, 3) * Cells(i, 1)) - (Cells(i, 3) * 1.007825)) > 0 Then

On Error Resume Next
lngPasteRow = Sheets("sheet1").Range("A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

On Error Goto 0

lngPasteRow = lngPasteRow + 1
End If

Sheets("sheet1").Range("A" & lngPasteRow) = ((Cells(i, 3) * Cells(i, 1)) - (Cells(i, 3) * 1.007825))
End If
Next i
End Sub

copyt
04-18-2012, 02:54 AM
Thank you very much again :bow::bow::bow::bow::bow::bow: