Dec 15 2021 05:20 AM - edited Dec 15 2021 06:20 AM
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.
Dec 15 2021 05:43 AM
Solution
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
Dec 15 2021 05:59 AM
Dec 15 2021 06:10 AM
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 & "*"
Dec 15 2021 06:20 AM
Dec 15 2021 05:43 AM
Solution
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