Dear friends,
Search Column I for the word “shelf”, when “shelf” is found, check if the cell directly below contains the word “width”. If the two conditions are met, carry out the code instructions.
If they are NOT met, continue to search col I till there is no more data.
VBA Code:
Dim r As Integer
Dim c As Integer
r = ActiveCell.Row
c = ActiveCell.Column
'search for "Shelf" search for any changed values in length,width and depth
Application.DisplayAlerts = False
Set rng = Range("I2:I1500") ' RANGE TO SEARCH
specificText = "Shelf" ' text to search for
For Each cell In rng.Cells
If UCase(cell.Value) Like "*" & UCase(specificText) & "*" Then
cell.Offset(1, 2).Select
Selection.Copy
cell.Offset(0, -3).Select
ActiveSheet.Paste
cell.Offset(1, 5).Select
Selection.Copy
cell.Offset(0, -4).Select
ActiveSheet.Paste
cell.Offset(1, 8).Select
Selection.Copy
cell.Offset(0, -2).Select
ActiveSheet.Paste
End If
Next
I'm always very grateful for your help.
Search Column I for the word “shelf”, when “shelf” is found, check if the cell directly below contains the word “width”. If the two conditions are met, carry out the code instructions.
If they are NOT met, continue to search col I till there is no more data.
VBA Code:
Dim r As Integer
Dim c As Integer
r = ActiveCell.Row
c = ActiveCell.Column
'search for "Shelf" search for any changed values in length,width and depth
Application.DisplayAlerts = False
Set rng = Range("I2:I1500") ' RANGE TO SEARCH
specificText = "Shelf" ' text to search for
For Each cell In rng.Cells
If UCase(cell.Value) Like "*" & UCase(specificText) & "*" Then
cell.Offset(1, 2).Select
Selection.Copy
cell.Offset(0, -3).Select
ActiveSheet.Paste
cell.Offset(1, 5).Select
Selection.Copy
cell.Offset(0, -4).Select
ActiveSheet.Paste
cell.Offset(1, 8).Select
Selection.Copy
cell.Offset(0, -2).Select
ActiveSheet.Paste
End If
Next
I'm always very grateful for your help.