PDA

View Full Version : Loop through cells and delete matching



dani9
05-30-2011, 05:32 AM
Hi,

I have the following problem; I have rows with text or with blanks, and inbetween blanks there are 3 or 5 rows with text. Now i need to see if they match, and if they do, then i have to delete them.

This would be sort of an example:


PWM
_______PWM
_______PWM
_______PWM
GMT
_______GMT
_______GMT
_______GMT
GMT
_______GMT
_______PWM
_______GMT


so in this case, it would delete the first three PWMs and frist three GMTs. But not the last ones, because they are different.

the end result would be.


PWM

GMT
GMT
_______GMT
_______PWM
_______GMT

any ideas? maybe something with loops? Any kind of help will be appreciated.

dani9
05-30-2011, 07:35 AM
I was thinking about something like this:

Find where LEN(ActiveCell) > 1 ' if the lenght of text is bigger than one - contains text
Then Loop - check if rows are equal
Until LEN(ActiveCell)<1 ' until next blank cell.

and then find the next cell with text in column, and so on until the last row.

could something like this work??

Bob Phillips
05-30-2011, 08:04 AM
Public Sub ProcessData()
Dim PrevValue As String
Dim AllTheSame As Boolean
Dim Lastrow As Long
Dim EndRow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

Lastrow = .UsedRange.Rows.Count
PrevValue = .Cells(Lastrow, "B").Value
AllTheSame = True
EndRow = Lastrow
For i = Lastrow To 1 Step -1

If .Cells(i, "A").Value2 <> "" Then

If AllTheSame Then

.Rows(i + 1).Resize(EndRow - i).Delete
End If
If i > 1 Then

EndRow = i - 1
PrevValue = .Cells(EndRow, "B").Value
AllTheSame = True
End If
ElseIf .Cells(i, "B").Value2 <> PrevValue Then

AllTheSame = False
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

dani9
05-30-2011, 11:53 PM
The code looks very good. Is there any way to change "A" to CurrentColumn - 1 and "B" to current column, because i have 12 columns.

I am writing the whole code so it is variable, if the number of columns and
rows change. So instead of "Lastrow" I am going to put in Range("MISLast").Offset(0, i), because it is all going from the column MIS, and this is my orientation for next 12 columns

dani9
05-31-2011, 12:31 AM
' Find and name cells and ranges
Cells.Find("MIS LVL4").Offset(1, 0).Select
Selection.Name = "MISFirst"
Cells.Find("MIS LVL4").End(xlDown).Select
Selection.Name = "MISLast"
Range("MISFirst", "MISLast").Select
Selection.Name = "MISColumn"

j = Range("MISColumn").Rows.Count
For i = 1 To 12
Cells.Find("LVL" & i).Offset(1, 0).Select
Selection.Name = ("First" & i)
Selection.Offset(j - 1, 0).Select
Selection.Name = ("Last" & i)
Range(("First" & i), ("Last" & i)).Select
Selection.Name = ("LVL" & i & "Col")
Next i

'************************************************************************** ***************
' Insert Formula
For i = 1 To 12
Range("MISFirst").Offset(0, i).Select
Range("MISFirst").Offset(0, i).FormulaR1C1 = "=IF(1<LEN(RC[-13]),RC[" & -i & "],"""")"
Range("MISFirst").Offset(0, i).AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(j, 0)), Type:=xlFillDefault
Range(ActiveCell, ActiveCell.Offset(j, 0)).Select
Selection.Copy
Selection.PasteSpecial xlPasteValues

Next i


Until now i have something like this, i already named the ranges for each of the 12 columns. maybe this could help?
How can i continue from this on?

dani9
05-31-2011, 01:03 AM
so i rearranged it a little bit, but it doesnīt delete duplicates and doesnīt move in the column before after finishing current column.

please repair my mistakes if you can?

With ActiveSheet
For j = 12 To 1
Lastrow = .UsedRange.Rows.Count
PrevValue = .Cells(Lastrow, ("LVL" & j & "Col")).Value
AllTheSame = True
EndRow = Lastrow

For i = Lastrow To 1 Step -1

If .Cells(i, ("LVL" & (j - 1) & "Col")).Value2 <> "" Then
If AllTheSame Then
.Rows(i + 1).Resize(EndRow - i).Delete
End If

If i > 1 Then

EndRow = i - 1
PrevValue = .Cells(EndRow, ("LVL" & j & "Col")).Value
AllTheSame = True
End If
ElseIf .Cells(i, ("LVL" & j & "Col")).Value2 <> PrevValue Then

AllTheSame = False
End If
Next i

Next j
End With

dani9
05-31-2011, 05:13 AM
I donīt think it recognizes this:

If .Cells(i, "A").Value2 <> "" Then


because in my file, i have no blanks, so that i why i have to put in something like If LEN(Cell text) > 1, then check if All the same.

If i put =ISBLANK() or ISTEXT, it doesnīt recognize it, so this is why i have to use this criteria with the lenght of characters.

please, any help would come in handy!

Bob Phillips
05-31-2011, 10:26 AM
What do you want to pursue, the original code or your latest adaptation?

dani9
05-31-2011, 11:54 PM
I am here now, at this code. I did the rearranging of your code, to suite my demands. but I come to a problem.

With ActiveSheet
For j = 12 To 1
Lastrow = .Range("StaFin" & j).Rows.Count
PrevValue = .Cells(Lastrow, ("StaFin" & j)).Value
AllTheSame = True
EndRow = Lastrow

For i = Lastrow To 1 Step -1

If .Cells(i, ("StaFin" & (j - 1))).Value2 <> " " Then
If AllTheSame Then
.Rows(i + 1).Resize(EndRow - i).Delete
End If

If i > 1 Then

EndRow = i - 1
PrevValue = .Cells(EndRow, ("StaFin" & j)).Value
AllTheSame = True
End If
ElseIf .Cells(i, ("StaFin" & j)).Value2 <> PrevValue Then

AllTheSame = False
End If
Next i
Next j
End With

this part of the code doesnīt skip the row in column A
If AllTheSame Then
.Rows(i + 1).Resize(EndRow - i).Delete
End If

At some point EndRow and i are the same, so Resize( 0 ) wonīt work.

Well, in the column A the data looks like this:

A__________B
PWM
_________pwm
_________pwm
_________pwm
PWM
PWM
PWM
_________pwm
_________pwm
GMT
________GMT
________GMT
GMT
GMT
________gmt
________pwm
________gmt


so sometimes, parents (column A) have no children, and these should remain, and not be deleted...

so how can we rewrite your code, so it skips the ones, that have no "children"??

dani9
06-06-2011, 04:07 AM
anyone? Any ideas??