This macro looks for matches in ranges S9:S16 and D9:D62 and if a match is not found, copies a portion of the row
to the 1st available blank row of the Range(D9:D62). Similarly, in case a match is found, inserts a row below the
matched value and copies the same range to the newly inserted row. For example, if S10 and D16 is a match, a new
row is inserted below D16 and Range (S16:W16) is copied in the newly inserted row. There can be multiple matches
where multiple rows are inserted. This code works, but it seems to be unable to dynamically account for the newly
inserted rows and subsequently unable to determine the last row. As a result, depending upon the number of rows
inserted, the code overwrites few last rows of the range.
I shall be most thankful if someone guides to me to a solution to the above problem.
to the 1st available blank row of the Range(D9:D62). Similarly, in case a match is found, inserts a row below the
matched value and copies the same range to the newly inserted row. For example, if S10 and D16 is a match, a new
row is inserted below D16 and Range (S16:W16) is copied in the newly inserted row. There can be multiple matches
where multiple rows are inserted. This code works, but it seems to be unable to dynamically account for the newly
inserted rows and subsequently unable to determine the last row. As a result, depending upon the number of rows
inserted, the code overwrites few last rows of the range.
I shall be most thankful if someone guides to me to a solution to the above problem.
VBA Code:
Sub Sort()
Dim e As Range
Dim foundVal As Range
Dim LR As Long
LR = Range("C" & Rows.Count).End(xlUp).Row
For Each e In Range("S9:S16")
Set foundVal = Range("D9:D62").Find(e, LookIn:=xlValues, lookat:=xlWhole)
If foundVal Is Nothing And e.Offset(, 6) = "Out of Stock"
Range("S" & e.Row & ":W" & e.Row).Copy Range("D" & LR + 1)
LR=LR+1
ElseIf Not foundVal Is Nothing And e.Offset(, 6) = "Available" Then
Range("D" & foundVal.Row).Offset(1).EntireRow.Insert
Range("S" & e.Row & ":W" & e.Row).Copy foundVal.Offset(1)
End If
Next e
End Sub