Solved: check column and delete

[parscon]

I use this VBA code and this code compare column A and Column B and if find same data on column B will delete data on Column A , (not column B)

Now i want this VBA check column B-C-D-E-F if the data on these column found on A column , delete the data on column A . (do not delete in others)

Please help me for this .

Thank you so much





Sub FinalCODE()


Dim firstcolumn() As Variant
Dim colA As Range
Dim colB As Range
Dim i As Long, del As Long

'This will set the ranges to look in. Note that this will only work for data with no blank cells. If you have blank cells, you can change these Set statements to the following:
' Set colA = Range("A1:A100") if you have 100 rows you want to look at.
Set colA = Range("A1", Range("A1").End(xlDown))
Set colB = Range("B1", Range("B1").End(xlDown))

firstcolumn = colA
ReDim Preserve firstcolumn(1 To UBound(firstcolumn), 1 To 2) As Variant
i = 1
del = 0
Do While i <= UBound(firstcolumn)
firstcolumn(i, 2) = Application.WorksheetFunction.CountIf(colB, firstcolumn(i, 1))
If firstcolumn(i, 2) > 0 Then
Range("A1").Offset(i - del - 1, 0).Delete Shift:=xlUp
del = del + 1
End If
i = i + 1
Loop

End Sub

[Bob Phillips]

Sub FinalCODE()
Dim firstcolumn() As Variant
Dim colA As Range
Dim colB As Range
Dim colC As Range
Dim colD As Range
Dim colE As Range
Dim colF As Range
Dim i As Long, del As Long

'This will set the ranges to look in. Note that this will only work for data with no blank cells. If you have blank cells, you can change these Set statements to the following:
' Set colA = Range("A1:A100") if you have 100 rows you want to look at.
Set colA = Range("A1", Range("A1").End(xlDown))
Set colB = Range("B1", Range("B1").End(xlDown))
Set colC = Range("C1", Range("C1").End(xlDown))
Set colD = Range("D1", Range("D1").End(xlDown))
Set colE = Range("E1", Range("E1").End(xlDown))
Set colF = Range("F1", Range("F1").End(xlDown))

firstcolumn = colA
ReDim Preserve firstcolumn(1 To UBound(firstcolumn), 1 To 2) As Variant
i = 1
del = 0
Do While i <= UBound(firstcolumn)
If Not IsError(Application.WorksheetFunction.CountIf(colB, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colC, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colD, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colE, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colv, firstcolumn(i, 1))) Then

Range("A1").Offset(i - del - 1, 0).Delete Shift:=xlUp
del = del + 1
End If
i = i + 1
Loop
End Sub

[parscon]

Thank you so much but i got error on this :




If Not IsError(Application.WorksheetFunction.CountIf(colB, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colC, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colD, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colE, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colv, firstcolumn(i, 1))) Then

[parscon]

Please fix it this code .

[Bob Phillips]

See if this is better



Sub FinalCODE()
Dim firstcolumn() As Variant
Dim colA As Range
Dim colB As Range
Dim colC As Range
Dim colD As Range
Dim colE As Range
Dim colF As Range
Dim i As Long, del As Long

'This will set the ranges to look in. Note that this will only work for data with no blank cells. If you have blank cells, you can change these Set statements to the following:
' Set colA = Range("A1:A100") if you have 100 rows you want to look at.
Set colA = Range("A1", Range("A1").End(xlDown))
Set colB = Range("B1", Range("B1").End(xlDown))
Set colC = Range("C1", Range("C1").End(xlDown))
Set colD = Range("D1", Range("D1").End(xlDown))
Set colE = Range("E1", Range("E1").End(xlDown))
Set colF = Range("F1", Range("F1").End(xlDown))

firstcolumn = colA
ReDim Preserve firstcolumn(1 To UBound(firstcolumn), 1 To 2) As Variant
i = 1
del = 0
Do While i <= UBound(firstcolumn)
If Not IsError(Application.WorksheetFunction.CountIf(colB, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colC, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colD, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colE, firstcolumn(i, 1))) Or _
Not IsError(Application.WorksheetFunction.CountIf(colv, firstcolumn(i, 1))) Then

Range("A1").Offset(i - del - 1, 0).Delete Shift:=xlUp
del = del + 1
End If
i = i + 1
Loop
End Sub

[parscon]

THank you but this code delete all data on column A . i have a data that it is not on column B-C - D-E-F but when run your VBA code delete all data on column A .

Thank you , please help me XLD .

[Bob Phillips]

Post the workbook so that I can see it.

[parscon]

i want delete the items on column A that repeat on column B-C-D-E-F and do not want delete any data on other column .

Thank you , you are too kind for helping people ,

Good Job Man .

[Bob Phillips]

Okay, this should be better



Sub FinalCODE()
Dim firstcolumn() As Variant
Dim colA As Range
Dim colB As Range
Dim colC As Range
Dim colD As Range
Dim colE As Range
Dim colF As Range
Dim i As Long, del As Long

'This will set the ranges to look in. Note that this will only work for data with no blank cells. If you have blank cells, you can change these Set statements to the following:
' Set colA = Range("A1:A100") if you have 100 rows you want to look at.
Set colA = Range("A1", Range("A1").End(xlDown))
Set colB = Range("B1", Range("B1").End(xlDown))
Set colC = Range("C1", Range("C1").End(xlDown))
Set colD = Range("D1", Range("D1").End(xlDown))
Set colE = Range("E1", Range("E1").End(xlDown))
Set colF = Range("F1", Range("F1").End(xlDown))

firstcolumn = colA
ReDim Preserve firstcolumn(1 To UBound(firstcolumn), 1 To 2) As Variant
i = 1
del = 0
Do While i <= UBound(firstcolumn)
If Application.CountIf(colB, firstcolumn(i, 1)) > 0 Or _
Application.CountIf(colC, firstcolumn(i, 1)) > 0 Or _
Application.CountIf(colD, firstcolumn(i, 1)) > 0 Or _
Application.CountIf(colE, firstcolumn(i, 1)) > 0 Or _
Application.CountIf(colF, firstcolumn(i, 1)) > 0 Then

Range("A1").Offset(i - del - 1, 0).Delete Shift:=xlUp
del = del + 1
End If
i = i + 1
Loop
End Sub

[parscon]

Thank you So much For your Good Work .

You sloved all my question on this forum .

Thank you .