PDA

View Full Version : Solved: compare 1 cell with 5 cell



parscon
05-10-2012, 07:59 AM
I have data on cell A1 like :
1, 3, 4, 5, 8, 9, 10, 11, 12, 44, 25, 55, 75, 110 , 135

data on cell B1 like :
3, 4, 9

data on cell C1 like :
44, 25, 1

data on cell D1 like :
11, 10

data on cell E1 like :
55

data on cell F1 like :
110, 135


I want to compare column A1 with all of them and if find any data from other column same data will be delete on column A .

Please help me , i need this code .

Tinbendr
05-10-2012, 10:35 AM
Option Explicit
Sub RemoveDups()
Dim Rng As Range
Dim aCell As Range
Dim A As Variant
Dim J As Variant
Dim B As Long
Dim I As Long
Dim Temp$
Set Rng = Range("B1:F1")
J = Split(Range("A1").Value, ",")
For Each aCell In Rng
If aCell <> "" Then
A = Split(aCell, ",")
For B = 0 To UBound(A)
For I = 0 To UBound(J)
If Trim(A(B)) = Trim(J(I)) Then
J(I) = ""
End If
Next
Next
End If
Next
For A = 0 To UBound(J)
If J(A) <> "" Then
Temp$ = Temp$ & J(A) & ","
End If
Next
Temp$ = Left(Temp$, Len(Temp$) - 1)
'Debug.Print Temp
Range("A1").Value = Temp$
End Sub

parscon
05-10-2012, 04:26 PM
Thank you very much . it is ok .

parscon
05-15-2012, 04:23 AM
I have problem this vBA code can not cmpare and delete data like this :

in column A i have data like this:
4600B(BM), ATTACHMENTS, L160 CO(BM), L160(BM), L90(BM), L70, L120E, L220F, L120E, L110F

in column B i have data like this:
L70 CO(BM)

in column C i have data like this:
L90(BM)

in column D i have data like this:
L120F, L110F

in column E i have data like this:
L220F, L220E, ATTACHMENTS

in cloumn F for this row i dow not have data .

when run this VBA code give me error :

Run-Time error '5': Invalid procedure call or argument and when click om debug shom me this line :

Temp$ = Left(Temp$, Len(Temp$) - 1)


Please help me for this problem

Thank you so much

Aussiebear
05-15-2012, 05:20 AM
Instead of trying to show the data is by typing, try attaching a sample workbook with a description of the error.

parscon
05-15-2012, 05:59 AM
Sample File attached .

I am sorry and thank you for your help .

Tinbendr
05-15-2012, 09:50 AM
Hmm, it ran without error.

Try this.
Option Explicit
Sub RemoveDups()
Dim Rng As Range
Dim aCell As Range
Dim A As Variant
Dim J As Variant
Dim B As Long
Dim I As Long
Dim Temp$
Set Rng = Range("B1:F1")
J = Split(Range("A1").Value, ",")
For Each aCell In Rng
If aCell <> "" Then
A = Split(aCell, ",")
For B = 0 To UBound(A)
For I = 0 To UBound(J)
If Trim(A(B)) = Trim(J(I)) Then
J(I) = ""
End If
Next
Next
End If
Next
For A = 0 To UBound(J)
If J(A) <> "" Then
Temp$ = Temp$ & J(A) & ","
End If
Next
If Len(Temp$) > 0 Then
Temp$ = Left(Temp$, Len(Temp$) - 1)
'Debug.Print Temp
Range("A1").Value = Temp$
End If
End Sub

parscon
05-15-2012, 12:32 PM
Dear ,

Thank you for your help .

Please check the attachment , this code not work . really i do not know whats the problem .

Thank you .

Tinbendr
05-15-2012, 12:42 PM
A1 and B! are exactly alike. Hence, nothing happens. (I just assumed that there would always be a difference.)

For exact matches, change the Else provisions to your liking.

parscon
05-15-2012, 12:45 PM
A1 will be blank .

Please check A4 , there are some data in B4 and D4 but nothing delete in column A4

Tinbendr
05-15-2012, 12:47 PM
A1 will be blank . Please

Just change
Range("A1").Value = "Contents are the same."

to Range("A1").Value = ""

parscon
05-15-2012, 12:47 PM
Sorry , It is Work and It is done .
Please write me how can use for all columns . currenly just it will work for 1 row that mean first row .

Thank you very much for your kind .

Tinbendr
05-15-2012, 02:01 PM
Option Explicit
Sub RemoveDups()
Dim WB As Workbook
Dim WS As Worksheet
Dim LastRow As Long
Dim Rng As Range
Dim aCell As Range
Dim A As Variant
Dim J As Variant
Dim B As Long
Dim I As Long
Dim AA As Long
Dim Temp$
Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)
With WS
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For AA = 1 To LastRow
Temp$ = ""
Set Rng = WS.Range("B" & AA & ":F" & AA)

J = Split(WS.Range("A" & AA).Value, ",")
For Each aCell In Rng
If aCell <> "" Then
A = Split(aCell, ",")
For B = 0 To UBound(A)
For I = 0 To UBound(J)
If Trim(A(B)) = Trim(J(I)) Then
J(I) = ""
End If
Next
Next
End If
Next
For A = 0 To UBound(J)
If J(A) <> "" Then
Temp$ = Temp$ & J(A) & ","
End If
Next
If Len(Temp$) > 0 Then
Temp$ = Left(Temp$, Len(Temp$) - 1)
'Debug.Print Temp
WS.Range("A" & AA).Value = Temp$
Else
WS.Range("A" & AA).Value = ""
End If
Next
End Sub

parscon
05-15-2012, 02:03 PM
Thank you very much , it is done .