excel macro to remove specific columns and rows + remove duplicate
Hello,
New forum user, I was a bit out of resources on google...so let's see if someone could maybe help me.
I started something with a friend to sort our list and need your help on the below code, as is it not working like a charm I need you help.
Actually we compiled several sources and try to make it work:
PHP Code:
Sub GetFiles()
Dim sThisFilePath As String
''''''''''''''''''''''''''''''''find keywords and delete rows...'''''''''''''''''''''''
'Workbooks(1).Activate
mycount = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To mycount
For j = 1 To 9
If InStr(Cells(i, j).Value, "keyword 1") > 0 Then
Cells(i, 1).EntireRow.Delete
End If
If InStr(Cells(i, j).Value, "keyword 2") > 0 Then
Cells(i, 1).EntireRow.Delete
End If
On Error Resume Next
Next j
Next i
'''''''''''''''' new updates'''''''''''''''''''''''''''''''''
mycount = Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox mycount
For i = 2 To mycount
j = 9
If InStr(Cells(i, 9).Value, "(") > 0 Or InStr(Cells(i, 9).Value, ")") > 0 Then
text1 = Cells(i, 9).Value
r = InStr(text1, "(")
s = InStr(text1, ")")
MsgBox r
MsgBox s
MsgBox text1
text2 = Mid(text1, r + 1, s - r - 1)
MsgBox text2
Cells(i, j).Value = text2
End If
If InStr(Cells(i, 9).Value, "qq.com") > 0 Then
Cells(i, 1).EntireRow.Delete
End If
If Len(Trim(Cells(i, 9).Value)) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
If InStr(Cells(i, 9).Value, "@") = 0 Then
Cells(i, 1).EntireRow.Delete
End If
text1 = Trim(Cells(i, 9).Value)
If Len(text1) < 4 Then
Cells(i, 1).EntireRow.Delete
End If
'If Left(Cells(i, 9).Value, 1) = "(" Then
'Cells(i, 9).Value = Mid(Cells(i, 9).Value, 2, Len(Cells(i, 9).Value) - 2)
'End If
'If Left(Cells(i, 9).Value, 3) = " " Then
'Cells(i, 9).EntireRow.Delete
'End If
Cells(i, 9).Select
If IsEmpty(ActiveCell) Then
Cells(i, 9).EntireRow.Delete
End If
Next i
''''''''''''''''''''''''''''Remove duplicates '''''''''''''''''''''''''''''''''''''''''
mycount = Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox mycount
For i = 2 To mycount
text1 = Trim(Cells(i, 9).Value)
For j = i + 1 To mycount
If Trim(Cells(j, 9).Value) = text1 Then
Cells(j, 9).EntireRow.Delete
mycount = mycount - 1
End If
Next j
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'For i = 2 To sheetscount
'Workbooks(i).Close
'Next i
Re: excel macro to remove specific columns and rows + remove duplicate
You have to be careful when looping and deleting entire rows or columns because you'll keep losing your point of reference.
Consider a program which is looping through the first three columns of the first three rows using two variables, RowLoop and ColLoop.
Let's say you find your first match on row 1, column 2, i.e RowLoop=1, ColLoop=2, and you delete that entire row. That means that what was row 2 now becomes row 1, so when you increment ColLoop you're looking at what was originally row 2, column 3 - the values in columns 1 & 2 of the original row 2 will never be checked.
It's also hideously slow to loop through every cell, you really want to use the .Find method to quickly find the values you're looking for.
Workbooks(1).Activate With Sheets("???active sheet????")
.Columns("AB:AB").EntireColumn.delete .Columns("Y:Z").EntireColumn.delete .Columns("R:T").EntireColumn.delete .Columns("P:P").EntireColumn.delete .Columns("B:N").EntireColumn.delete .Columns("R:T").EntireColumn.delete End With
End Sub
''''''''''''''''''''''''''''''''2) ANDREW _ R KEYWORD FINDER AND ROW REMOVE.''''''''''''''''''''''' Sub DeleteRows()
Const sSTART_CELL = "A2"
Dim rngSearchArea As Range Dim rngMatch As Range Dim avSearchTerms As Variant Dim lSearchLoop As Long
avSearchTerms = Array("keyword 1", "keyword 2")
Set rngSearchArea = Range(Range(sSTART_CELL), Cells(Rows.Count, Range(sSTART_CELL).Column).End(xlUp)).Resize(, 9)
For lSearchLoop = LBound(avSearchTerms) To UBound(avSearchTerms)
Set rngMatch = rngSearchArea.Find(avSearchTerms(lSearchLoop), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
While Not rngMatch Is Nothing
rngMatch.EntireRow.Delete
Set rngMatch = rngSearchArea.Find(avSearchTerms(lSearchLoop)) Wend
Next lSearchLoop
End Sub '''''''''''''''' 3) new updates REMOVE ()before and after text'''''''''''''''''''''''''''''''''
Next i ''''''''''''''''''''''''''''Remove duplicates ''''''''''''''''''''''''''''''''''''''''' mycount = Cells(Rows.Count, 1).End(xlUp).Row 'MsgBox mycount For i = 2 To mycount text1 = Trim(Cells(i, 9).Value) For j = i + 1 To mycount If Trim(Cells(j, 9).Value) = text1 Then Cells(j, 9).EntireRow.Delete mycount = mycount - 1 End If Next j Next i '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'For i = 2 To sheetscount 'Workbooks(i).Close 'Next i
End Sub Next i ''''''''''''''''''''''''''''Remove duplicates ''''''''''''''''''''''''''''''''''''''''' mycount = Cells(Rows.Count, 1).End(xlUp).Row 'MsgBox mycount For i = 2 To mycount text1 = Trim(Cells(i, 9).Value) For j = i + 1 To mycount If Trim(Cells(j, 9).Value) = text1 Then Cells(j, 9).EntireRow.Delete mycount = mycount - 1 End If Next j Next i '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'For i = 2 To sheetscount 'Workbooks(i).Close 'Next i
End Sub
Last edited by garrywelson; 01-16-2013 at 11:36 AM.
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks