copy/paste with if condizion

[nicitalia]

Hi guys,
here's my problem:

I must copy some cells that are not adjacent one to another located in column A, to column F.

With my sub I search for every cell that is font.bold = true, and once fuond i must copy it in cell F1, than the next cell found with font.bold=true in F2 and so on...

Hope someone could help...I'm breackin' my head!!!




Sub EliminaDuplicati2()

With Worksheets(1).Range([A2], [A2].End(xlDown)).Select

For Each c In Selection
If c.Font.Bold = True Then
c.Resize(1, 4).Select

Selection.Copy

'and now????


End If
Next
End With
End Sub

 

[SkipVought]

Hi,

Must you COPY, which includes all the formatting and other properties of the cell, or do you just want the VALUES that are in the cell?

Why the Resize?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

and then what?

Where do you need to PASTE or PUT the value?????

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

I think I understand

Sub EliminaDuplicati2()
    Dim c As Range
    
    For Each c In Worksheets(1).Range([A2], [A2].End(xlDown))
        If c.Font.Bold = True Then
            c.Copy Cells(c.Row, "F")
        End If
    Next

End If

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

oops, that last End If, should have been End Sub!

Sub EliminaDuplicati2()
    Dim c As Range
    
    For Each c In Worksheets(1).Range([A2], [A2].End(xlDown))
        If c.Font.Bold = True Then
            c.Copy Cells(c.Row, "F")
        End If
    Next

End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[nicitalia]

Well thank you so much skip for the reply!

I must copy each that sattisfy the if condition cell starting from F2, I mean eg. A5 is font.bold, than copy it in F2, then the next cell in column A wich contain a value written in font.bold is A15, ok so copy it in F3 and so on...
I have to do that 'cause I have 60.000 record in column A, but many entries are the same value, so i wanna have only the effective value...

sorry for my English hope you'll understand

Nic

 

[SkipVought]

This did not work?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[nicitalia]

Hi, it works but it copy the cells not in F1,F2,F3,F4... but in the column F and the same row of the cell.font.bold = true!

Es. a value is found in A12, the sub copy it in F12 and not in the first empty cell of column F...
you know a way to do that???

thank you so much

nic

 

[Gavona]

...but many entries are the same value, so i wanna have only the effective value...

One option to hide identical rows is:
Advanced filter
leave criteria unspecified
Unique values only



Gavin

 

[SkipVought]

Sub EliminaDuplicati2()
    Dim c As Range, lRow as long
    
    For Each c In Worksheets(1).Range([A2], [A2].End(xlDown))
        If c.Font.Bold = True Then
            lRow = application.CountA([F:F])
            c.Copy Cells([F2].offset(lRow).row, "F")
        End If
    Next
End Sub

Use Gavin's usggestion regarding getting a unique list.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[nicitalia]

Thank you guys,

I'll try and I'll let you know.

@gavin: ok I didn't know that way yet, thank you!!!

 

[nicitalia]

I've not tried your sub yet, skip,

but I was tryin' these sub:

<<<<first, I've to say that I've puted on the last cell of my range in column A the value "end" written in bold>>>>>
Sub EliminaDupplicati10()

FIRST SUB: this is working correctly but the loop doesn't stop, can you tell me why???

FirstCell = Range("A2").Address

Do
For Each c In Worksheets("liquidi").Range([A2], [A2].End(xlDown))
If c.Font.Bold = False Then c.EntireRow.Delete
If ActiveCell.Value = "end" Then Exit Do
Next

Loop While ActiveCell.Address <> FirstCell
End Sub

SECOND SUB: same problem of the first one, it works but loop never stop!!! why???

Sub EliminaDupplicati11()

Do While ActiveCell <> "fine"
For Each c In Worksheets("liquidi").Range([A2], [A2].End(xlDown))
If c.Font.Bold = False Then c.EntireRow.Delete
Next
Loop

End Sub


THIRD SUB: FINALLY THIS ONE WORK AND THE LOOP DOES STOP! i MEAN WHERE IS MY MYSTAKE WITH THE DO...LOOP???


Sub EliminaDupplicati12()

While ActiveCell = "fine"
For Each c In Worksheets("liquidi").Range("A2:A226")
If c.Font.Bold = False Then c.EntireRow.Delete
Next
Wend

MsgBox "There are " & ActiveSheet.UsedRange.Rows.Count - 1 & " values."

End Sub

THANK YOU FOR THE PATIENCE....
NIC

 

[nicitalia]

Thank you skip the do exactly what i want!!!