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.
Bookmarks