Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    Oct 2013
    Posts
    19
    Thanks
    3
    Thanked 0 Times in 0 Posts

    If conditions met, then move columns

    Hi,

    Needs VBA code: In column C Id, if value is found repeated in the same column then check Column A & B if all three columns matched then move the data from Column D onwards to first Id, and delete that row whose data is moved to its matching columns.

    Sample:
    Attached Images Attached Images

  2. #2
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,353
    Thanks
    49
    Thanked 275 Times in 253 Posts
    fjohan,

    I believe this is what you are trying to achieve:

    The code looks for matching rows by comparing Col A, B, and C. If match(s) found, the duplicate rows are deleted and their phone numbers are appended to the original. To speed the comparison and reduce looping, the code first sorts the data and compares the concatenation of columns A, B, and C for each Row.

    HTH,
    Maud

    Before code ran:
    MatchID.png

    After Code ran:
    MatchID2.png

    Code:
    Sub MatchID()
    Application.ScreenUpdating = False
    '-----------------------------------
    'DECLARE AND SET VARIABLES
    Dim TestVal As String, CompareVal As String
    Dim LastRow As Long, LastCol As Long
    '-----------------------------------
    'SORT BY INVOICE#, DESCRIPTION, ID
        LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        Range("A1:H" & LastRow).Select
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A" & LastRow)
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B" & LastRow)
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C2:C" & LastRow)
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A1:H" & LastRow)
            .Header = xlYes
            .Apply
        End With
    '-----------------------------------
    'COMPARE ROWS AND LOOK FOR MATCH (CYCLE BACKWARDS)
        For I = LastRow To 3 Step -1
            TestVal = Cells(I, 1) & Cells(I, 2) & Cells(I, 3)
            For J = I - 1 To 2 Step -1
                CompareVal = Cells(J, 1) & Cells(J, 2) & Cells(J, 3)
    '-----------------------------------
    'MATCH FOUND- APPEND PHONE AND DELETE MATCH ROW
                If TestVal = CompareVal Then
                    LastCol = ActiveSheet.Cells(I, Application.Columns.Count).End(xlToLeft).Column
                    Cells(I, LastCol + 1) = Cells(J, 4)
                    Cells.Rows(J).Delete
                    I = I - 1
                Else:
                    Exit For
                End If
            Next J
        Next I
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files

  3. #3
    New Lounger
    Join Date
    Oct 2013
    Posts
    19
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Thanks Maud,

    Yes thats what i wanted, but for sample i had created that if A,B & C match then move to E column, infact there are chances that cell may contain data or may be the next one also so its better that we move to the empty cell instead of fixed cell.


    Thanks in advance.
    Last edited by fjohan; 2014-12-01 at 15:18.

  4. #4
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,353
    Thanks
    49
    Thanked 275 Times in 253 Posts
    fjohan,

    The code is not set to move to a fixed cell, It will move to the next available cell in the row therefore, it will accommodate any number of phone entries

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •