writing a macro in Excel to align 2 sets (columns) of data based on names.


I need to compare 2 sets/columns of alpha names and move to align the words(data) in

See attached sample file.  No, vlookups won't work.  I wish.

IF Col 1 'text' not equal <> Col 4, then move col 1 and col 2 all data down 1 row. If Col 1 'text' is equal = Col 4, then GO down and check next row. Once all t he rows (Col 1 and Col 4 names) are aligned, I will be able to add the data in Col 2 and Col 5.

If the alpha name in A1 is not the same as in column B, then move A1 and all the rows of words/data below A1 down one row.  Repeat the comparison. The end goal is to add   the number beside the name in column A + number beside the aligned name in column b.  But only if the words align. 

Column B is the complete set of words/data.  Column A is incomplete so the rows don't align.    

Please help!  Thank you!!



I'm a bit confused as it doesn't seem like you would need a macro for this, but, instead just a lookup formula. Please include a sample worksheet for clarification.

And edit your question to update the title so it reflects what you actually want to do.
don (rep: 1979) Jan 8, '18 at 4:02 pm
If the macro you want is indeed as simple as you say then your description of it certainly doesn't make it look like that. Many people don't know what an "alpha name" is or how to "align" words. I'm sure nobody knows where to get the number from that should be next to the name in column A which is aligned with column B. The latter might become clear when you post a copy of your workbook ("sterilise" it for public consumption). As to the other points you might consider revising your question to better express your intention.
Variatus (rep: 4864) Jan 8, '18 at 7:26 pm
Hi.  Thanks for your help.  A vlookup won't work in this instance.  I am trying to align two sets of data based on a name that's why I indicated 'alpha name' I'm not looking for values/numbers.  I need to match specific names so that I can add across rows of numbers beside the name.  I included a sample excel file.  Hope you can see it.  Thanks.  
IanM (rep: 2) Jan 9, '18 at 4:56 pm
Add to Discussion


Selected Answer

The code below will do what you have described. I have filled in, best guess, what you didn't describe which is what should happen to other data in the same rows. Sticking with your sample, data in columns B:D are moved down relative to everything else on the sheet. Take a good look at the enumeration at the top of the code. That is where you can make significant changes. Also look at the name of the worksheet. I used "Alpha" because I found "Sheet1" too generic. A good, descriptive name will go a long way toward preventing the code being run unintentionally on data you don't want changed.

Option Explicit
Enum Nws                                ' worksheet navigation
    ' 10 Jan 2018
    ' ==== Set1End determines the last column to
    '      be moved down together with Name1
    '      Observe that columns left of Name1 will not be moved
    NwsFirstDataRow = 8                 ' adjust as required
    NwsName1 = 2                        ' 2 = column B
    NwsSet1End = 4
    NwsName2                            ' 5 = column E
End Enum
Sub CompareAndAlignNames()
    ' 10 Jan 2018
    Dim Ws As Worksheet
    Dim Rng As Range
    Dim Arr1() As Variant, Arr2() As Variant
    Dim R As Long, R1 As Long
    Dim i As Long, j As Long
    Set Ws = Worksheets("Alpha")        ' name the sheet with the name lists on them
    With Ws
        ' write nothing below data in columns Name1 and Name2 !
        R = .Cells(.Rows.Count, NwsName2).End(xlUp).Row
        Set Rng = Range(.Cells(NwsFirstDataRow, NwsName2), .Cells(R, NwsName2))
        Arr2 = Rng.Value
        R = .Cells(.Rows.Count, NwsName1).End(xlUp).Row
        Set Rng = Range(.Cells(NwsFirstDataRow, NwsName1), .Cells(R, NwsSet1End))
        Arr1 = Application.Transpose(Rng.Value)
    End With
    For R = 1 To UBound(Arr2)
        R1 = R1 + 1
        If StrComp(Arr2(R, 1), Arr1(1, R1), vbTextCompare) Then
            ReDim Preserve Arr1(LBound(Arr1) To UBound(Arr1), _
                                LBound(Arr1, 2) To UBound(Arr1, 2) + 1)
            For i = UBound(Arr1, 2) To (R1 + 1) Step -1
                For j = LBound(Arr1) To UBound(Arr1)
                    Arr1(j, i) = Arr1(j, i - 1)
                Next j
            Next i
            For j = LBound(Arr1) To UBound(Arr1)
                Arr1(j, i) = ""
            Next j
        End If
    Next R
    With Rng
        .Cells(1).Resize(UBound(Arr1, 2), UBound(Arr1)).Value = Application.Transpose(Arr1)
    End With
End Sub

There is a working example in the attached workbook.



Thanks very much.  You've made my day!!
IanM (rep: 2) Jan 10, '18 at 1:10 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login