Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How do I put a copy and paste command into an Excel VB Do loop

Status
Not open for further replies.

wabahn

Technical User
Oct 23, 2008
20
US
I receive a series of files with differing numbers of rows. The field names information are always the last row in the file and I would like to move it to the 1st row using a cut/paste insert command. Because the number of rows differs from file to file, I am using a do until loop to find the field names. I can't get the cut/paste to work, what am I doing wrong?

Here is an example of my code - The title for the 1st column is -77

Range("a1").Select
Do Until Selection.Value = ""
If Selection.Value = "-77" Then
Application.CutCopyMode = False
ActiveCell.EntireRow.Selection
Selection.Cut
Range("1:1").Select
Selection.Insert Shift:=xlDown
Else
End If
Selection.Offset(1, 0).Select
Loop
 
I'd replace this:
ActiveCell.EntireRow.Selection
with this:
ActiveCell.EntireRow.Select

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 


Hi,

Doing a CUT or DELETE in a top to bottom loop is going to destroy your location cell reference.

It would be much better to add a helper column for SORTING and SORT these rows to the TOP, rather than Cut 'n' Paste. You could really do it with out code.

Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
PHV and Skip Vought

Thanks for getting back to me so quickly.

PHV - I changed the selection to select (I missed that on the first try). Unfortunately that wasn't the problem but the code is now correct.

I also tried manually inserting a blank row and copying the data to the top using activecell.entirerow.select That didn't work either. Is there a way to run a counter in the code during the looping process and then using the counter to identify the row number to copy from as part of a range?

I am finding Excel VB a bit challenging (my prior experience was with Access) My data files have to be reformatted (remove blank lines, rearrange some columns, etc - you know the deal with .txt files). The last items on my to do list were moving the field names to the top of the list and sorting the data (which of course is in descending order). I have the sort working, so the only challenge left is the copy/cut paste.




 
What about this ?
Code:
Dim r As Long: r = 2
Do Until Cells(r, 1).Value = ""
  If Cells(r, 1).Value = -77 Then
    Rows(r).EntireRow.Cut
    Rows(1).Insert Shift:=xlDown
    Application.CutCopyMode = False
    Exit Sub
  End If
  r = r + 1
Loop

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
PHV - Works like a charm!! Thanks
 
Hi i'm a beginer with VBA.
I have a situation where data in a folder Sheet1 has 4000 rows. The value i am lookingup in this eg is "2.5".
Upon finding this data I wanted the program to copy the whole row and paste it into sheet2.
The peoblem is "2.5" is repeated more than once. So i need the loop to pull out all the 2.5's and paste it in the new sheet.

Problem # 2
I may have a situation wher the exact match is not found in this case i want it to find 5 or 10 of the closest values close to 2.5.

I've tried something but obviously i have anproblem with the code working. Appreciate if some one could assist.

Sub testloop()

Dim r As Long: r = 8

Do Until Sheets("Sheet1").Cells(r, 1).Value = ""
If Sheet1.Cells(r, 1).Value = 2.5 Then
ActiveCell.EntireRow.Copy
Sheets("Sheet2").Rows(1).Insert Shift:=xlDown
Application.CutCopyMode = False
Exit Sub
End If
r = r + 1

Loop
End Sub


 
Guess I have solved teh first part of the problem.
Still need help on the second part ie.

I may have a situation wher the exact match is not found in this case i want it to find 5 or 10 of the closest values close to 2.5.



Sub testloop()
Sheet2.Cells.Select
Selection.Delete
Dim r As Long: r = 8
Do Until Sheet1.Cells(r, 1).Value = ""
If Sheet1.Cells(r, 1).Value = 2.5 Then
Sheet1.Rows(r).EntireRow.Copy
Sheet2.Rows(1).Insert Shift:=xlDown
Application.CutCopyMode = False

End If
r = r + 1
Loop
End Sub
 


Then you may want another loop to incriment, +/-, around your value

Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top