How to copy, insert and replace cell data based on cell content search in comulmns using VBA

Question

I am trying to copy all the 3 rows which contains cells with "red" and similar with blue when the user gives the Input in the userform.

What I required is, when the user gives "red" and want to replace red with "green" and "click on commandbutton", the new rows should be created by copying the rows contatining red and replace red with green.

Userform:

TextBox to search : red

Sub Add()

sheet_name = "Sheet1"
column_name = "C"

For r = 1 To Sheets(sheet_name).Range(column_name & Rows.Count).End(xlUp).row
    If Trim(Sheets(sheet_name).Cells(r, column_name).Value) = team_name Then
        Sheets(sheet_name).Rows(r).EntireRow.Select
        Selection.Copy
        ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
        Selection.Insert Shift:=xlDown
        Selection.Replace What:=team_name, Replacement:=emp_name, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
    End If
Next
column_name = "E"
For r = 1 To Sheets(sheet_name).Range(column_name & Rows.Count).End(xlUp).row
    If Trim(Sheets(sheet_name).Cells(r, column_name).Value) = team_name Then
        Sheets(sheet_name).Rows(r).EntireRow.Select
        Selection.Copy
        ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
        Selection.Insert Shift:=xlDown
        Selection.Replace What:=team_name, Replacement:=emp_name, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
    End If
Next
End sub

TextBox to replace : green The Excel sheet Looks like below:

Output should be like below:

Please include the code you are using in your question to attempt this. — braX, Nov 20 '19 at 08:47
Yes updated, in the Code **team_name** is TextBox to **search** and **emp_name** is Textbox to **Replace** the team name — sant, Nov 20 '19 at 08:51
Are they always in groups of 3? What exactly is the problem with your current code? You would benefit from reading https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — SJR, Nov 20 '19 at 09:43
When I run my Code the new rows are copied in different rows not as I required. — sant, Nov 20 '19 at 10:48

AsUsual · Accepted Answer · 2019-11-21T13:45:19.347

I don't see how your code could give that result, try this.

Sub Add()
    Dim sh As Worksheet, c As Range, cnt As Integer, cl As Long, tN$, eN$

    Set sh = Sheets(1) 'sheet by index
    cl = 4 'column by index
    tN = "blue": eN = "green"

    With sh
        'For cl = 3 To 5 Step 2
            For Each c In .Range(Cells(1, cl), Cells(Rows.Count, cl).End(xlUp))
                If LCase(c) Like LCase(tN) & "*" Then
                    .Cells(c.Row, 1).Resize(, 6).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6)
                    .Cells(Rows.Count, 1).End(xlUp).Resize(, 6).Replace tN, eN, xlWhole, , False
                    If cnt > 3 Then Exit Sub
                    cnt = cnt + 1
                End If
            Next c
        'Next cl
    End With
End Sub

LCase() isn't needed if you're consistent in your input to the code.

And if you want to loop through your columns of choice un-comment [For cl..] and [Next cl], this won't result in 3 rows though, since C or E doesn't contain any team on row 6.

This works perfect!! If the Groups of 3 varies to 4 or 5 but I need first 3 lines only, what changes to be made in the Code? — sant, Nov 21 '19 at 07:04

How to copy, insert and replace cell data based on cell content search in comulmns using VBA

1 Answers1