CODEWITHSUNDEEP
stringexcelvbasearchconcatenation
user2108977
user2108977

Reputation: 27

How to replace the contents of a cell based on row header?

I need to search every cell in row 1 (a1 to dv1) for the instance where "doc1" is followed in the subsequent cell in that row by "doc2." Then I need to concatenate the contents of what's in the cell one row below the cell containing "doc1" with what's in the cell one row below the cell containing "doc2", separated by a comma, and replacing the text in what's in the cell below the cell containing "doc1".

So, for example, if a1 has "doc1" and b1 has "doc2" and a2 has "7" and b2 has "8", then I need a2 to be replaced with "7, 8".

Any help would be greatly appreciated.

Thanks, Amy

Upvotes: 2

Views: 248

Answers (1)

cardmagik
cardmagik

Reputation: 1698

Here is a solution in VBA - you can just copy and paste this in a new module in VBA (backup your spreadsheet first), then run it (with F5). To get to VBA fast, use alt-F11. I've left my MSGBOX statements in the code commented out. Also, the code goes until DW1 so it can finish DV1.

Option Explicit

Sub Doc1_Doc2_Merge()

    Dim CurrCol As Integer
    Dim CurrRow As Integer
    Dim NewValue As String
    Dim EndCol As String

    For CurrRow = 1 To 50 Step 2 '(assume 50 rows - skip 2 lines each time)
       CurrCol = 1

       EndCol = "$DW$" & Trim(Str(CurrRow))
       While Cells(CurrRow, CurrCol).Address <> EndCol

           'MsgBox Cells(CurrRow, CurrCol).Address & " " & Cells(CurrRow, CurrCol).Value

           If InStr(Cells(CurrRow, CurrCol).Value, "doc1") > 0 Then
               ' look at next cell
               If InStr(Cells(CurrRow, CurrCol + 1).Value, "doc2") > 0 Then
                   If Trim(Cells(CurrRow + 1, CurrCol + 1).Value) <> "" Then
                       NewValue = Cells(CurrRow + 1, CurrCol).Value & "," & Cells(CurrRow + 1, CurrCol + 1)
                       'MsgBox "New Value is " & NewValue
                       Cells(CurrRow + 1, CurrCol).Value = NewValue
                   End If
               End If

           End If

           CurrCol = CurrCol + 1
       Wend
    Next CurrRow

End Sub

Here are test results: enter image description here

Upvotes: 2

Related Questions