Forum Discussion

ShazSh's avatar
ShazSh
Brass Contributor
Dec 15, 2021
Solved

Find the String if Match then write to adjacent Columns

I have created this code which finds the string in Column and if macthes then write the values in adjacent columns.

currently my code is using Sheet2 Row2 values to update the data in Sheet1. I want to include the all rows that are available in Sheet2

I want to make it dyanmic. I will appreciated your help.

 

attached a sheet as well for better understanding.

Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Dec 15, 2021

     

    Sub Updatevalues()
    Dim lastrow As Long, rng As Range
    Dim lastrow2 As Long, rng2 As Range, cel As Range
    Application.ScreenUpdating = False
    With Sheet2
        lastrow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rng2 = .Range("B2:B" & lastrow2)
    End With
    For Each cel In rng2
        With Sheet1
            .AutoFilterMode = False
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rng = .Range("B1:B" & lastrow)
            rng.AutoFilter Field:=1, Criteria1:=cel.Value & "*"
            On Error Resume Next
            rng.Offset(1, 2).SpecialCells(12).Value = cel.Offset(0, 1).Value
            rng.Offset(1, 3).SpecialCells(12).Value = cel.Offset(0, 2).Value
            rng.Offset(1, 4).SpecialCells(12).Value = cel.Offset(0, 3).Value & ""
            On Error GoTo 0
        End With
    Next cel
    With Sheet1
        .Cells(lastrow + 1, 4).Resize(1, 3).ClearContents
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

    ShazSh 

4 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Dec 15, 2021

     

    Sub Updatevalues()
    Dim lastrow As Long, rng As Range
    Dim lastrow2 As Long, rng2 As Range, cel As Range
    Application.ScreenUpdating = False
    With Sheet2
        lastrow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rng2 = .Range("B2:B" & lastrow2)
    End With
    For Each cel In rng2
        With Sheet1
            .AutoFilterMode = False
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rng = .Range("B1:B" & lastrow)
            rng.AutoFilter Field:=1, Criteria1:=cel.Value & "*"
            On Error Resume Next
            rng.Offset(1, 2).SpecialCells(12).Value = cel.Offset(0, 1).Value
            rng.Offset(1, 3).SpecialCells(12).Value = cel.Offset(0, 2).Value
            rng.Offset(1, 4).SpecialCells(12).Value = cel.Offset(0, 3).Value & ""
            On Error GoTo 0
        End With
    Next cel
    With Sheet1
        .Cells(lastrow + 1, 4).Resize(1, 3).ClearContents
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

    ShazSh 

    • ShazSh's avatar
      ShazSh
      Brass Contributor
      Dec 15, 2021
      Sir i have updated the new workbook with other values in Sheet2 but its not updating data for last value smoke.
      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Dec 15, 2021

        ShazSh 

        That is because the entries on Sheet1 don't begin with "THE SMOKE PIT":

         

        SQ *THE SMOKE PIT PTY Thomastown

         

        Change the line

                    rng.AutoFilter Field:=1, Criteria1:=cel.Value & "*"

        to

                    rng.AutoFilter Field:=1, Criteria1:="*" & cel.Value & "*"

Resources