bring same rows side by side - please help macro

[osmanoca]

hello please help
i have 4 columns and there words in them. i want a code to bring same rows in column C with B to side bye side same row with moving C and D rows together. so i want to see same words in C next to same words in B but code must move C words with its meaning in D. others that not same can be deleted or can be in bottom.
example:
A - B - C - D
baş - good - eye - çav
xirab - bad - friend - hogir
çav - eye - good - rind
heval - friend - eat - xwarin

i want them in result.

A - B - C - D
baş - good - good - rind
çav - eye - eye - çav
heval - friend - friend - hogir


please help with macro

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub AlignWordsBasedOnColumnsBandC()
  Dim X As Long, Z As Long, Arr As Variant, Words As Variant, Result As Variant
  Application.ScreenUpdating = False
  With Range("C1", Cells(Rows.Count, "D").End(xlUp))
    Arr = .Value
    ReDim Result(1 To UBound(Arr), 1 To 2)
    Words = Application.Transpose(.Columns.Offset(, -1).Resize(, 1))
    .ClearContents
    For X = 1 To UBound(Words)
      For Z = 1 To UBound(Arr)
        If Words(X) = Arr(Z, 1) Then
          Result(X, 1) = Arr(Z, 1)
          Result(X, 2) = Arr(Z, 2)
          Exit For
        End If
      Next
    Next
    .Value = Result
    On Error GoTo NoBlanks
    Intersect(.Resize(, 1).SpecialCells(xlBlanks).EntireRow, Columns("A:D")).Delete xlShiftUp
  End With
NoBlanks:
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[osmanoca]

this code works good but it doesnt make all words. i see that there are many words that same in both columns but it didnt take to new arrange.

so there is a small problem .

 

[Peter_SSs]

so there is a small problem .

Perhaps a small set of sample data and expected results for which the suggested code did not do what you wanted?

 

[Rick Rothstein]

this code works good but it doesnt make all words. i see that there are many words that same in both columns but it didnt take to new arrange.

Are the words all the same casing? Are they spelled exactly the same? Actually, I would be willing to bet that if you check, you will find one of the pair of words has one or more trailing blanks in it. If I am right about the trailing space, then this modified code should work (it will also handle different letter casing as well)...

[table="width: 500"]
[tr]
	[td]Sub AlignWordsBasedOnColumnsBandC()
  Dim X As Long, Z As Long, Arr As Variant, Words As Variant, Result As Variant
  Application.ScreenUpdating = False
  With Range("C1", Cells(Rows.Count, "D").End(xlUp))
    Arr = .Value
    ReDim Result(1 To UBound(Arr), 1 To 2)
    Words = Application.Transpose(.Columns.Offset(, -1).Resize(, 1))
    .ClearContents
    For X = 1 To UBound(Words)
      For Z = 1 To UBound(Arr)
        If UCase(Trim(Words(X))) = UCase(Trim(Arr(Z, 1))) Then
          Result(X, 1) = Trim(Arr(Z, 1))
          Result(X, 2) = Trim(Arr(Z, 2))
          Exit For
        End If
      Next
    Next
    .Value = Result
    On Error GoTo NoBlanks
    Intersect(.Resize(, 1).SpecialCells(xlBlanks).EntireRow, Columns("A:D")).Delete xlShiftUp
  End With
NoBlanks:
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[osmanoca]

yes thanks i thought like you, perhaps case and spaces make problem. i wll check and return. thanks really.

 

[osmanoca]

thank you dear sir and firends. it worked good. the god help you in your life as you helped me.

see you thanks very much all.