CODEWITHSUNDEEP
excelvba
sant
sant

Reputation: 101

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

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:

enter image description here

Output should be like below: enter image description here

Upvotes: 1

Views: 71

Answers (1)

AsUsual
AsUsual

Reputation: 524

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.

Upvotes: 2

Related Questions