Search for a string in a column and copy the values of the next column when there is succesful match

Question

I'm new to VBA programming. I have a case where I need to search for strings from the top of the column and match with the particular string in the subsequent rows of that column. This what I have:

Basically I need a vba prog which will search for the multiple occurrences of the string and get the values next to the matched strings beside the first occurrence. As shown in the figure .Can anyone help me with this. I have recorded a macro but no use of it because the values change every time.

> Sub Macro1() ' ' Macro1 Macro '
> 
> '
>     Range("B32:B59").Select
>     Selection.Cut
>     ActiveWindow.SmallScroll Down:=-15
>     Range("C2").Select
>     ActiveSheet.Paste
>     ActiveWindow.SmallScroll Down:=39
>     Range("B62:B89").Select
>     Selection.Copy
>     Application.CutCopyMode = False
>     Selection.Cut
>     ActiveWindow.SmallScroll Down:=-60
>     Range("D2").Select
>     ActiveSheet.Paste
>     ActiveWindow.SmallScroll Down:=78
>     Range("B92:B119").Select
>     Selection.Cut
>     ActiveWindow.SmallScroll Down:=-96
>     Range("E2").Select
>     ActiveSheet.Paste
>     ActiveWindow.SmallScroll Down:=114
>     Range("B122:B149").Select
>     Selection.Cut
>     ActiveWindow.SmallScroll Down:=-144
>     Range("F2").Select
>     ActiveSheet.Paste
>     ActiveWindow.SmallScroll Down:=147
>     Range("B152:B179").Select
>     Selection.Cut
>     ActiveWindow.SmallScroll Down:=-168
>     Range("G2").Select
>     ActiveSheet.Paste
>     ActiveWindow.SmallScroll Down:=15
>     Range("A32:A179").Select
>     Selection.ClearContents
>     ActiveWindow.SmallScroll Down:=-42 End Sub

This is the MACRO I recorded for a simple file. this is the sample result file:

Answer 1

This is a VBA solution that should get you going. I have made some assumptions so you will likely have to tweak it to get your final requirement.

Only run this on a copy of your data. 10,000 rows is a lot of repair work!

It first sorts the data, iterates through the values and discards the duplicate rows. The output is therefore in a sorted order based on valCol (Col A in your data)

I have used my test data on Sheet3 with original data positioned at (stDataRow, valCol). Change these in the code to suit your data set-up.

Finally, note that in the output rows, the order of the values in the columns (left to right) is in the order of where they appear (bottom to top) in the original data.

Option Explicit
Sub CollectData()
Dim ws As Worksheet
Dim stDataRow As Long, endDataRow As Long, valCol As Long
Dim endDataCol As Long, colCnt As Long, c As Long
Dim dataRng As Range, fndVal As Range

Set ws = Sheets("Sheet3")
stDataRow = 2
valCol = 1

    With ws
        endDataRow = Cells(Rows.Count, valCol).End(xlUp).Row
        endDataCol = Cells(stDataRow, Columns.Count).End(xlToLeft).Column
        Set dataRng = .Range(.Cells(stDataRow, valCol), .Cells(endDataRow, endDataCol))

        dataRng.Sort Key1:=Columns(valCol), Order1:=xlAscending

            For c = endDataRow To stDataRow + 1 Step -1
                colCnt = valCol
                Set fndVal = .Cells(c, valCol)
                    Do While fndVal.Value = fndVal.Offset(-1, 0).Value
                        If fndVal.Value = fndVal.Offset(-1, 0).Value Then
                            colCnt = colCnt + 1
                            fndVal.Offset(0, colCnt).Value = fndVal.Offset(-1, 1).Value
                            fndVal.Offset(-1, 0).EntireRow.Delete
                        End If
                    Loop
            Next c
    End With

End Sub