PDA

View Full Version : If Loop to paste



JDone
10-16-2007, 08:21 AM
Hey everyone,

I want to create a spreadsheet (just an exercise to learn VBA) with band names in columns A and the number of CDs I have of that band in Column B .
Now the problem I have is creating code to copy and paste both the band name and the number of CD to another sheet when the number of CD's I have of that band is larger than 2.
I guess it should be a loop to go through each band name?
Can anyone help plz

Thanks.

matthewspatrick
10-16-2007, 08:43 AM
Instead of looping, try this:


Sub GrabData()
Dim Source As Worksheet
Dim Dest As Worksheet

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets.Add

With Source
.Range("a1").AutoFilter 2, ">2", xlAnd
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Dest.Range("a1")
.Range("a1").AutoFilter
End With

MsgBox "Done"

End Sub

matthewspatrick
10-16-2007, 08:44 AM
The code assumes you have headings in Row 1, and that you want to copy the headings too.

Norie
10-16-2007, 09:19 AM
Why not use advanced filter to get the unique band names into column A?

Then insert a COUNTIF formula in column B.

All of which can be done with code.

mikerickson
10-16-2007, 05:32 PM
There are a lot of ways to do this.

One piece of code that you might use is

Sheets("Sheet2").Range("a4:b5").Value = Sheets("Sheet1").Range("a1:b2").Value which duplicates the values in Sheet1!A1:B2 in Sheet2!A4:B5. It's the equivilant of Copy/PasteValues, but faster.

To loop through cells, I prefer the Cells property to the Range property. This will show the contents of every filled cell in column A.
Dim i As Long
Dim lastRow as Long
lastRow = ActiveSheet.Range("a65536").End(xlup).Row
For i = 1 to lastRow
Msgbox ActiveSheet.Cells(i,1)
Next i
A slight modification will show the contents of only those cells that have a duplicate somewhere in Column A.
Dim i As Long
Dim lastRow As Long
Dim oneCellContents As Variant
lastRow = ActiveSheet.Range("a65536").End(xlUp).Row
For i = 1 To lastRow
oneCellContents = ActiveSheet.Cells(i, 1)
If 1 < Application.CountIf(ActiveSheet.Range("A:A"), oneCellContents) Then
MsgBox oneCellContents
End If
Next iI hope this helps.