bloodmilksky
Board Regular
- Joined
- Feb 3, 2016
- Messages
- 202
Hi Guys I was just wondering if anyone knows how to use the below code or even a different code to return groups of ranges as I am having real trouble get the below to work.
' Defines LastRow as last row of column C of the Lenses sheet containing data
LastRow = Sheets("Lenses").Cells(Rows.Count, "C").End(xlUp).Row
' If target cell is A1 then...
If Not Intersect(Target, Range("A29")) Is Nothing Then
' If target value is not blank then...
If Target.Value <> "" Then
' Sets FindString as the value of A1 (case insensitive)
FindString = UCase(Target.Value)
' Sets search range as Solutions sheet C1 to last row
Set sRange = Sheets("Lenses").Range("B29:D36,E29:G36,H29:J36,B37:D44,E37:G44,H37:J44,H45:J52,E44:G52,B45:D52")
' Set variable RowNo as 1
RowNo = 29
' For each cell in the search range
For Each Cell In sRange
' If the cell contains the FindString value (case insensitive) then...
If InStr(1, UCase(Cell.Value), FindString) Then
' Copy columns A:D of the cell row from Solutions and paste to the current RowNo of column B of Menu
Sheets("Lenses").Range("Lenses1").Copy Range("Return")
' Increase RowNo by 1 to account for the new data
RowNo = RowNo + 1
End If
' Check next cell in search range
Next Cell
' If the name was not found then...
If Range("B29") = "" Then
' Display an error stating the name is not in the list
MsgBox "Specified name does not exist", vbOKOnly, "Attention!"
' Clear the contents of A1
Target.ClearContents
' Reselect cell A1
Range("A10").Select
End If
' Else if A1 is empty...
Else
' Clear the contents of B:E on the Menu sheet
Range("B29:G70").ClearContents
End If
End If
End Sub
' Defines LastRow as last row of column C of the Lenses sheet containing data
LastRow = Sheets("Lenses").Cells(Rows.Count, "C").End(xlUp).Row
' If target cell is A1 then...
If Not Intersect(Target, Range("A29")) Is Nothing Then
' If target value is not blank then...
If Target.Value <> "" Then
' Sets FindString as the value of A1 (case insensitive)
FindString = UCase(Target.Value)
' Sets search range as Solutions sheet C1 to last row
Set sRange = Sheets("Lenses").Range("B29:D36,E29:G36,H29:J36,B37:D44,E37:G44,H37:J44,H45:J52,E44:G52,B45:D52")
' Set variable RowNo as 1
RowNo = 29
' For each cell in the search range
For Each Cell In sRange
' If the cell contains the FindString value (case insensitive) then...
If InStr(1, UCase(Cell.Value), FindString) Then
' Copy columns A:D of the cell row from Solutions and paste to the current RowNo of column B of Menu
Sheets("Lenses").Range("Lenses1").Copy Range("Return")
' Increase RowNo by 1 to account for the new data
RowNo = RowNo + 1
End If
' Check next cell in search range
Next Cell
' If the name was not found then...
If Range("B29") = "" Then
' Display an error stating the name is not in the list
MsgBox "Specified name does not exist", vbOKOnly, "Attention!"
' Clear the contents of A1
Target.ClearContents
' Reselect cell A1
Range("A10").Select
End If
' Else if A1 is empty...
Else
' Clear the contents of B:E on the Menu sheet
Range("B29:G70").ClearContents
End If
End If
End Sub