Excel VBA Macro find and replace nextRow nextColumn

[yousufj56]

Hi there,

Here is my task:

Sheet2: Column A will contain string that i want to find in Sheet1 and replace with the values given in Columns B to myLastColumn.

Sheet1: Column A will contain identical string from row 1 to myLastRow. Each cell will contain string found in Sheet2, column A. I want to replace this string with values from Sheet2, Columns B to myLastColumn.

However;

Sheet1, Cell A1 will be replaced by values in Sheet2, column B (10 rows).

Then, Sheet1, Cell A2 will be replaced by Sheet2, column C (10 rows).

Then, Sheet1, Cell A3 will be replaced by Sheet2, Column D (10 rows).

This will continue until the lastrow is reached in Sheet1 and the last column is reach in Sheet2.

Sub myReplace()


    Dim myDataSheet As Worksheet
    Dim myReplaceSheet As Worksheet
    Dim myLastRow As Long
    Dim myRow As Long
    Dim myColumn As Long
    Dim myLastColumn As Long
    Dim myFind As String
    Dim myReplace As String
    
'   Specify name of Data sheet
    Set myDataSheet = Sheets("Sheet1")
    
'   Specify name of Sheet with list of replacements
    Set myReplaceSheet = Sheets("Sheet2")
    
'   Assuming list to search start in column A on row 2, find last entry in list
    myLastRow = myReplaceSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
'   Assuming list of replacement start in column B on row 2, find last entry in list
    myLastColumn = myReplaceSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    
    Application.ScreenUpdating = False
    
'   Loop through all list of replacments
    For myRow = 2 To myLastRow
    For myColumn = 2 To myLastColumn
'       Get find and replace values (from columns A and B)
        myFind = myReplaceSheet.Cells(myRow, "A")
        myReplace = myReplaceSheet.Cells(myRow, myColumn)
'       Start at top of data sheet and do replacements
        myDataSheet.Activate
        Range("A1").Select
'       Ignore errors that result from finding no matches
        On Error Resume Next
'       Do all replacements on column A of data sheet
        Columns("A:A").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
'       Reset error checking
        On Error GoTo 0
    Next myColumn
    Next myRow
    
    Application.ScreenUpdating = True
    
    MsgBox "Replacements complete!"
    
End Sub

Thanks in advance!!

 

[BrianJN1]

Are you meaning by:

However;

Sheet1, Cell A1 will be replaced by values in Sheet2, column B (10 rows).

Then, Sheet1, Cell A2 will be replaced by Sheet2, column C (10 rows).

Then, Sheet1, Cell A3 will be replaced by Sheet2, Column D (10 rows).

that, as an example:
Contents of A1 = "A B C D E F G H I J", the contents of 10 rows of Col B Sheet2,
Contents of A2 = "D I G K N L I F E R", the contents of 10 rows of Col C Sheet2,
Contents of A3 = "G H J R W Q Y I O" , the contents of 10 rows of Col D Sheet2,
etc?

Maybe an image of what you intend might be an assist.

 

[yousufj56]

Hi, yes, judging by your example, i think we are on the same page.

Here are some screenshots:

https://imgur.com/a/v9ejB

 

[yousufj56]

Wait sorry, i would like to make one revision to your example:

Its more like this:

Contents of A1 = "A B C D E F G H I J", the contents of 10 rows of Col B Sheet2,
Contents of A2 = "A B C D E F G H I J", the contents of 10 rows of Col C Sheet2,
Contents of A3 = "A B C D E F G H I J", the contents of 10 rows of Col D Sheet2,

 

[BrianJN1]

I therefore get the impression you wish to concatenate into one cell the contents of 10 consecutive cells as you go down the column.

If that is so, I think that if you modify my code it will meet your needs (I haven't looked for the last row or column confining myself to a specific grid).
Consider my image as an overlay of Sheet1 (where the result is to appear) and Sheet2 where the column data is stored.

Sub Buildrow()
'
' Buildrow Macro
'

'
    Dim a, b, c, d, e, f As Long
    Dim thislist As String
    For a = 2 To 7
    thislist = Cells(a, 1).Value
    For b = 2 To 4
    Sheets("Sheet2").Select
    thislist = thislist & "," & Cells(a, b).Value
    
    Next b
   
     Sheets("Sheet1").Range("A" & a).Value = thislist
     Next a
End Sub

Excel 2013/2016
	A	B	C	D	E	F
1	SHEET1		SHEET2
2	Pppp,A,W,Z		Pppp	A	W	Z
3	Qqqq,D,E,D		Qqqq	D	E	D
4	Rrrr,F,R,F		Rrrr	F	R	F
5	Jjjj,G,T,G		Jjjj	G	T	G
6	Llll,H,Y,H		Llll	H	Y	H
7	Bbbb,J,U,J		Bbbb	J	U	J
Sheet1

 

[BrianJN1]

Stop. I mixed up my rows and columns. changing the order of that graphic shows three rows as such:
Pppp,A,D,F,G,H,J
Qqqq,W,E,R,T,Y,U
Rrrr,Z,D,F,G,H,J

The code for that is:

Sub Buildrow()
'
' Buildrow Macro
'

'
    Dim a, b, c, d, e, f As Long
    Dim thislist As String
    Sheets("Sheet2").Select
    For a = 2 To 4
    thislist = Cells(a, 1).Value
    For b = 2 To 7
    
    thislist = thislist & "," & Cells(b, a).Value
    
    Next b
   
     Sheets("Sheet1").Range("A" & a).Value = thislist
     Next a
End Sub