Solved: Macro for write value without duplicate

[Rayman]

I attached a simple file with 2 sheets and a macro that fill a column of a sheet with value taken from the other sheet. What i am unable to do is remove duplicate for calculate a simple media.
Best of my words (very poor english) for understand the problem is take a look at the attached file that is self-explanatory.

Thanks in advance for your help

[Bob Phillips]

You don't need a macro, Advanced Filter has a 'Unique Records Only' option.

[Rayman]

You don't need a macro, Advanced Filter has a 'Unique Records Only' option.

HI xld,

thanks for reply but the file i attached is only an example.

I need a macro to do what i want in my project.

In any case, i tryed your suggestion, but i could not get the desired result with the advance filter options.....

[Bob Phillips]

Okay, I think I understand. Can you re-post you workbook, but fill ij the values you expect in the score column, or just tell us what values you expect?

[Rayman]

Okay, I think I understand. Can you re-post you workbook, but fill ij the values you expect in the score column, or just tell us what values you expect?
Ok thanks xld,

i reattached the file with more explanation ( within the limit of my bad english:( )

Sorry, i made a mistake , please read in this way the text in Command Button: "This button write the score in column "D" based on value in sheet "SUPPLIER"

[Bob Phillips]

You really don't need VBA, this formula does what you want

=VLOOKUP(C2,Supplier!$A:$B,2)

[Rayman]

You really don't need VBA, this formula does what you want

=VLOOKUP(C2,Supplier!$A:$B,2)

Xld,

I think , that cause my poor english , we do not understand:

My code:Dim RngDay, RngSupplier, Supplier, celSupplier
Set RngDay = Sheets("Day").Range("C2:C100").SpecialCells(xlCellTypeConstants)
Set RngSupplier = Sheets("Supplier").Columns(1)
For Each celSupplier In RngDay
Set Supplier = RngSupplier.Find(celSupplier)
If Not Supplier Is Nothing Then celSupplier.Offset(, 1) = Supplier.Offset(, 1)

Next

do the same that Vlookup do, so for each supplier it write his corresponding score. What i need to do is write the score only one time for each name.
In sheet "Day" i can have supplier "A" , for example, in row 3,5,25,100 ecc. but the score must be written only on row 3.

Hope you can understand me and... "viceversa":think:

Thanks again for your time

[Bob Phillips]

The example you posted had values in all the A's :)

I see where the uniques come in now, but still think you don't need code. Try this formula

=IF(COUNTIF($C$2:$C2,$C2)>1,"",VLOOKUP(C2,Supplier!$A:$B,2))

[Rayman]

The example you posted had values in all the A's :)

I see where the uniques come in now, but still think you don't need code. Try this formula

=IF(COUNTIF($C$2:$C2,$C2)>1,"",VLOOKUP(C2,Supplier!$A:$B,2))

Ok xld , thanks
tomorrow, when ill go to office, ill try your formula and let you know.

Good night

[Bob Phillips]

Okay, I hope it does what you want.

If you have Italian Excel, it might need to be


=SE(CONTA.SE($C$2:$C2;$C2)>1;"";CERCA.VERT(C2;Supplier!$A:$B;2))

[Rayman]

Okay, I hope it does what you want.

If you have Italian Excel, it might need to be


=SE(CONTA.SE($C$2:$C2;$C2)>1;"";CERCA.VERT(C2;Supplier!$A:$B;2))

Good Morning xld,

i try your formula and it work perfectly, but...what i want to do is a bit more complicated.:devil2:
The file that i yesterday attached was a semplification of my project, for example, my working woorkbook do not have only one sheet ("Day") but many "Day" sheets whit variable names, also, the working woorkbook as not formulas in it (to prevent unintentionals deletion) and i want to continue in this way.
In case you have time and patience , i attached a new self explanatory file , whit commented code that should you help to understand what i need to do

Thanks in advance and have a good day.

[Bob Phillips]

i try your formula and it work perfectly, but...what i want to do is a bit more complicated.:devil2:

Isn't it always :(


The file that i yesterday attached was a semplification of my project, for example, my working woorkbook do not have only one sheet ("Day") but many "Day" sheets whit variable names, also, the working woorkbook as not formulas in it (to prevent unintentionals deletion) and i want to continue in this way.

This is VERY different to what you first asked for, but if I understand correctly, this does it



Sub ValForn()
Dim MySheet As Worksheet
Dim sht As Worksheet
Dim RngFornA As Range
Dim RngFornB As Range
Dim CelFornA As Range
Dim P As Range
Dim Commessa As String
Dim LunghFoglioGiornale As Long
Dim vecScores As Variant
Dim idxScores As Long

Application.ScreenUpdating = False

Commessa = Worksheets("Riassuntivo Commessa").Range("E2")

For Each sht In ActiveWorkbook.Sheets

If sht.Range("A1") = Commessa Then

Set MySheet = sht
Exit For
End If
Next

With MySheet

If .FilterMode = True Then .ShowAllData

LunghFoglioGiornale = .Cells(Rows.Count, 1).End(xlUp).Row
Set RngFornA = .Range("I4:I" & LunghFoglioGiornale).SpecialCells(xlCellTypeConstants)
Set RngFornB = Worksheets("Elenchi").Range("F2:F100")

ReDim vecScores(1 To 1)
For Each CelFornA In RngFornA

Set P = Nothing
Set P = RngFornB.Find(CelFornA)
If Not P Is Nothing Then

idxScores = idxScores + 1
ReDim Preserve vecScores(1 To idxScores)
vecScores(idxScores) = P.Offset(0, 1)
End If
Next
End With

Worksheets("RIASSUNTIVO COMMESSA").Range("E27").Value2 = Application.Median(vecScores)

Application.ScreenUpdating = True

End Sub

[Rayman]

Isn't it always :(



This is VERY different to what you first asked for, but if I understand correctly, this does it



Sub ValForn()
Dim MySheet As Worksheet
Dim sht As Worksheet
Dim RngFornA As Range
Dim RngFornB As Range
Dim CelFornA As Range
Dim P As Range
Dim Commessa As String
Dim LunghFoglioGiornale As Long
Dim vecScores As Variant
Dim idxScores As Long

Application.ScreenUpdating = False

Commessa = Worksheets("Riassuntivo Commessa").Range("E2")

For Each sht In ActiveWorkbook.Sheets

If sht.Range("A1") = Commessa Then

Set MySheet = sht
Exit For
End If
Next

With MySheet

If .FilterMode = True Then .ShowAllData

LunghFoglioGiornale = .Cells(Rows.Count, 1).End(xlUp).Row
Set RngFornA = .Range("I4:I" & LunghFoglioGiornale).SpecialCells(xlCellTypeConstants)
Set RngFornB = Worksheets("Elenchi").Range("F2:F100")

ReDim vecScores(1 To 1)
For Each CelFornA In RngFornA

Set P = Nothing
Set P = RngFornB.Find(CelFornA)
If Not P Is Nothing Then

idxScores = idxScores + 1
ReDim Preserve vecScores(1 To idxScores)
vecScores(idxScores) = P.Offset(0, 1)
End If
Next
End With

Worksheets("RIASSUNTIVO COMMESSA").Range("E27").Value2 = Application.Median(vecScores)

Application.ScreenUpdating = True

End Sub

MANY ,MANY THANKS xld, your code work well, i only change Application.Median with Application.Average (Median , with 2 supplier , one with score 100 other with score 50 give a result of 100) i cannot understand the logic in this function:dunno

But your code has let me understand the instruction "Redim" and "Preserve".

You are a GENIUS:thumb

Good evening

[Bob Phillips]

MEDIAN(100,50) gives 75 for me. As help says ...

If there is an even number of numbers in the set, then MEDIAN calculates the average of the two numbers in the middle.

[Rayman]

MEDIAN(100,50) gives 75 for me. As help says ...

If there is an even number of numbers in the set, then MEDIAN calculates the average of the two numbers in the middle.

Yes, xld , if we have only 2 supplier one with 100 and other with 50.
But if you have , for example:

day 1 Supplier De.ca, score 50, Supplier Magazzino , score 100
Day 2 Supplier Magazzino , score 100
we have a result of median= 100
But the media of the 2 supplier is not 100