Vba help returning blocks of values

[bloodmilksky]

Hi Guys,

I am currently using the below code to return rows of data. but I was wondering one of 2 things.

1. Can you return columns of data instead of rows?
2. Can you use this code to return blocks of information like B15:C25

Private Sub Worksheet_Change(ByVal Target As Range)
' Defines variables
Dim FindString As String, Rng As Range, sRange As Range, RowNo As Integer, Limit As Long
' Defines LastRow as last row of column C of the Sales Rep sheet containing data
LastRow = Sheets("Sales Reps").Cells(Rows.Count, "C").End(xlUp).Row
' If target cell is A1 then...
If Not Intersect(Target, Range("A2")) 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 Sales Rep sheet C1 to last row
Set sRange = Sheets("Sales Reps").Range("C1:C" & LastRow)
' Set variable RowNo as 1
RowNo = 2
Limit = 1
' 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 Sales Rep and paste to the current RowNo of column B of Menu
Sheets("Sales Reps").Range("C" & Cell.Row, "G" & Cell.Row).Copy Range("B" & RowNo)
' Increase RowNo by 1 to account for the new data
RowNo = RowNo + 1
Limit = Limit + 1
If Limit = 11 Then GoTo LimitReached
End If
' Check next cell in search range
Next Cell
LimitReached:
' If the name was not found then...
If Range("B2") = "" 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("A2").Select
End If
' Else if A1 is empty...
Else
' Clear the contents of B:E on the Menu sheet
Range("B2:F11").ClearContents
End If
End If

 

[Gary McMaster]

Below is a sample addressing ("returning") various groups of cells. The example uses colors but once you have specified the range of cells you want to work with you can read/write data or do anything else you want with them. Any desired groups of cells can be "returned" to any procedure. However, the code you have posted is using the worksheet change event. You must be careful when making CHANGES inside a CHANGE event. Doing so can cause the change procedure to call itself recursively resulting in an endless loop (possible lockup). See VBA help for "Application.EnableEvents" which can provide a way around unwanted recursion.

In a standard module:

Public Sub Test()

Dim iColor As Integer
Dim oCell As Range
Dim oRange As Range

ActiveSheet.Cells.Interior.ColorIndex = xlColorIndexNone

'Your question 1
Set oRange = ActiveSheet.Range("D:D") 'Address entire column D
oRange.Interior.ColorIndex = 3

iColor = 1

'Your question 2
Set oRange = ActiveSheet.Range("B15:C25") 'Address the range "B15:C25"

'Visit each cell in range B15:C25
For Each oCell In oRange
    oCell.Interior.ColorIndex = iColor
    oCell.Value = Chr(65 + iColor)
    Debug.Print oCell.Address & vbTab & oCell.Text
    iColor = iColor + 1
Next oCell

'Address a non contiguous block of cells
Set oRange = ActiveSheet.Range("H13:H27, K13:K27, I18:J21, M13:M27, O13:O22, O25:O27")

oRange.Interior.ColorIndex = 4

'Address the entire row of cells containing cell "J29"
ActiveSheet.Range("J29").EntireRow.Interior.ColorIndex = 6

End Sub

 

[bloodmilksky]

thats great thank you. Cause I am still learning, can I assume that I would change the "DIM iColour" To range?

 

[Gary McMaster]

Not exactly. Look at the "For Each" loop. That loop visits each cell in B15:C25 then writes a character into the cell.

Exactly what are you trying to do?

 

[bloodmilksky]

have a search box on Sheet "menu" that retrieves blocks of data from another sheet "Customers"

The returned value will just be their profile. but the range will be B13:F27

 

[Gary McMaster]

have a search box on Sheet "menu" that retrieves blocks of data from another sheet "Customers"

The returned value will just be their profile. but the range will be B13:F27

Still not exactly sure what you want. The following snip will retrieve the data from B13:F27 of a sheet named "Customers" and show it to you in a message box one cell at a time. The "Customers" sheet does not have to be the active sheet when you run it.

In a standard module:

Public Sub Test()

Dim iAnswer As Integer
Dim oCell As Range
Dim oProfile As Range

Set oProfile = ThisWorkbook.Worksheets("Customers").Range("B13:F27")

For Each oCell In oProfile
    iAnswer = MsgBox(oCell.Text, vbOKCancel, "Data From B13:F27")
    If iAnswer = vbCancel Then Exit Sub
Next oCell

End Sub

 

[bloodmilksky]

Hi,

Does the below make a bit more sense? as to what I am trying to do.


' 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