Search & cell reference

[sskappel]

Sorry, forget this post, can't get the code /code function to work to preserve spacing...

I have some problems in my first attempt of vb-excel programming. Hope someone have time to help. I will do my best to keep questions clear.

I'm developing a workbook to log trading activity of futures products. It's all basic cell references with search, copy and filter functions. However, I am all new to visual basic, and have problems to find my desired functionality in my searches for resources.

In general I try to reference cells with variables. Instead of (A1:A3) I would like to say (val1:val2). This does not seem to be exactly straight forward.

I wish to make the following functionality:

Reference cells in a sheet by knowing a unique value in one column and the heading of the desired columns.

Example:

Sheet "CONTRSPEC" looks like this:

A B C D
SYM BPVAL EXCH MONTHS
YM 5 CBOT HUMVZ
ES 12.5 CME HUMVZ
NQ 12.5 CME HUMVZ



In sheet "TRADE", I manually make these entries:

A B C
ES BPVAL
MONTHS



Then I want to click a button which will populate an array with the respective values from CONTRSPEC, based on my selections in columns B and C in TRADE.

Then I would like to get these values transferred to a third sheet called LOG:

LOG:

A B C D E F
# SYM DATE BPVAL ENTRY MONTHS
ES 12.5 HUMVZ

The transfer should find the respective columns by searching the headings (row 1), because I might change the order of the headings in later updates.

sorry if this is very basic things, but hope anyone will give some examples of which functions I should use..

ss

[Jacob Hilderbrand]

Try something like this:

Option Explicit

Sub Log()
Dim Val1 As String
Dim Val2 As String
Dim Val3 As String
Dim Row As Long
Dim Col1 As Long
Dim Col2 As Long
Dim TargetRow As Long
Val1 = Sheets("TRADE").Range("A1").Text
Val2 = Sheets("TRADE").Range("B1").Text
Val3 = Sheets("TRADE").Range("C1").Text
With Sheets("CONTRSPEC")
Row = .Range("A:A").Find(What:=Val1, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True).Row
Col1 = .Range("1:1").Find(What:=Val2, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True).Column
Col2 = .Range("1:1").Find(What:=Val3, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True).Column
End With
With Sheets("LOG")
TargetRow = .Range("A65536").End(xlUp).Row + 1
.Range("A" & TargetRow).Value = _
Sheets("CONTRSPEC").Range(Cells(Row, 1).Address).Value
.Range("B" & TargetRow).Value = _
Sheets("CONTRSPEC").Range(Cells(Row, Col1).Address).Value
.Range("C" & TargetRow).Value = _
Sheets("CONTRSPEC").Range(Cells(Row, Col2).Address).Value
End With
End Sub

See the attached file to see how I set the data up in the sheets.

[johnske]

Hi sskappel, welcome to vba express.
I'm not quite sure what you're after so I'll just give you some more ideas to start with:
If you want to reference things by value {Instead of (A1:A3) I would like to say (val1:val2)} you need to do some thinglike this:

Option Explicit
Sub FindARangeByValue()
Dim Val1, Val2 As Range
Dim Find1, Find2, Known1, Known2 As String
With ActiveSheet.Range("A1:Z100")
          Known1 = InputBox("What is Value1?")
          Set Find1 = .Find(Known1, LookIn:=xlValues)
          If Not Find1 Is Nothing Then Find1.Select
          Set Val1 = Selection
Known2 = InputBox("What is Value2?")
          Set Find2 = .Find(Known2, LookIn:=xlValues)
          If Not Find2 Is Nothing Then Find2.Select
          Set Val2 = Selection
          Range(Val1, Val2).Select
End With
End Sub

To find a column heading, there's no need to specify a row IF your sheet column headings
are unique, you can just put something like this:

Sub FindAheading()
Dim Known As String
Dim Heading
Known = InputBox("What is the heading for the column you want to look in?")
With ActiveSheet.Range("A1:Z100")
Set Heading = .Find(Known, LookIn:=xlValues)
If Not Heading Is Nothing Then Heading.Select
On Error Resume Next
If Selection = Heading Then MsgBox ("There is a " & Heading & " in cell " & ActiveCell.Address) Else
End With
End Sub[/vba]
If the column headings are not unique you put something like this (this also searches down till the value is found)
[vba]Sub FindIt()
Dim Known, Lost As String, Count, SearchRows As Integer
Dim Heading, Address As Range
Known = InputBox("What is the heading for the column you want to look in?")
'//assuming your heading is in the 1st row
With ActiveSheet.Rows(1)
Set Heading = .Find(Known, LookIn:=xlValues)
If Not Heading Is Nothing Then Heading.Select
If Heading Is Nothing Then Exit Sub
End With
Lost = InputBox("What are you looking for?")
SearchRows = InputBox("Number of rows to search down for " & Lost & "?")
With Selection
      Count = 0
      Do Until Selection = Lost
            Selection.Offset(1, 0).Select
            'if lost becomes found, give a message
            If Selection = Lost Then MsgBox ("There is a " & Lost & " in cell " & ActiveCell.Address)
            'also, for the point of this exercise, write the address of this cell in cell A1
            If Selection = Lost Then Range("A1") = ActiveCell.Address
            Count = Count + 1
                  If Count = SearchRows Then
                        MsgBox ("Sorry, no " & Lost & "'s found in the 1st " & SearchRows & " rows")
                        Selection.Offset(-SearchRows, 0).Select
                        Exit Sub
                  End If
      Loop
End With
End Sub

There are several ways these actions can be performed but I hope these ideas are a help to get you started...
John

[sskappel]

DRJ & johnske
Thanks very much! This looks interesting.

I made some progress on my own, but are stucked with an error.
I will examine your code soon and then post some more specific questions.

[sskappel]

Edit: OOPS! It is working, Please don't bother about first question below. Goto **

I have this function which is working nice:

Function LastRow(sh As Worksheet) 'Returns row no. of last empty row
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

I would like to make a similar function, to search for the last entry in a specific column. But the following gives a "Subscript out of range" message: why?

Function LastRowOfColumn(sh As Worksheet) 'Returns row no. of last empty row of col...
On Error Resume Next
LastRowOfColumn = sh.Range("A:A").Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

**
I would also like to pass the range A:A as a parameter to this function. Something like;

Sub .....() 
Dim col as Range
Dim lastRow as Integer
Set col = Range("A:A")
lastRow = LastRowOfColumn(Sheets("RANGELISTS", col)
....
End Sub

This is probably not correct syntax. Please correct me!
And how would i put the parameter into the line LastRow = ....... in the above function?

(Sorry about bad indentation, it does not preserve how I submit it)

[sskappel]

I'm aware of the solution below, but would like to know how to do it with a variable defined as a range variable.

Function LastRowOfColumn(sh As Worksheet, col As String)                 'Returns row no. of last empty row of col...
    On Error Resume Next
    LastRowOfColumn = sh.Range("" & col & ":" & col & "").Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

[sskappel]

Found solution. Currently I have no unanswered question, but I will probably bump into problems soon.

Function LastRowOfColumn(columnRange As Range)                 'Returns row no. of last empty row of col...
    On Error Resume Next
    LastRowOfColumn = columnRange.Find(What:="*", _
                            After:=columnRange.Cells(1, 1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

[sskappel]

Edited: Updated with some explaining comments.

Things are working really well. But I still am in need for some help. I try to make the code as reusable as possible. Now I only have it triggered by one button. But I try to make it possible to use for several buttons as I will need it.

(I attached the excel file in case anyone have interest of testing it.)

Problem 1:
The choice of which row to make transfer from is based on my selection in a list-box. The list-box displays the values of column A, with heading "SYM", in CONTRSPEC. The values in this columns are of type String. I will like to make the type and column here optional, like the other settings. So I'm not forced to make a selection based on this column & type String. Then I can move it up to the SettingsForButtonSend Sub. I tried to change it to type Variant, but that produced error. I'm extremely greatful if anyone sees a solution on this.

Problem 2:
Some of my choices in list-box triggers a transfer from wrong row. For example BO and LB. Yes, I know I don't have any validation coding, maybe that will help. But still is a bit mysterious.

'The purpose of this code is to transfer cells from one sheet to another.
'Cell selection is based on selecting one row, based on criteria in one column
'and selecting columns based on the headings in row 1 of the source sheet.
'Names of column headings to transfer cells from is listed in the 'transferSheet'
'By this I can change wich columns to transfer, without editing the vb-code
 
Option Explicit
Public sym As String
Public colName As String
Public srcSheet As Worksheet 'Source sheet
Public dstSheet As Worksheet 'Destination sheet
Public transferSheet As Worksheet 'Transfer sheet w/ values of column headings
Public srcRange As Range
Public dstRange As Range
Public transferRange As Range
 
Sub SettingsForButtonSend()
'Settings:
Set srcSheet = Worksheets("CONTRSPEC")
Set dstSheet = Worksheets("LOG")
Set transferSheet = Worksheets("RANGELISTS")
Set transferRange = transferSheet.Range("A:A")
Set srcRange = srcSheet.Range("A:XX")
Set dstRange = dstSheet.Range("A:XX")
End Sub

Private Sub SendButton_Click()
SettingsForButtonSend
sym = ListBox1.Value 'Gets value from list box selection
Dim Row As Integer
Dim srcCol As Integer
Dim dstCol As Integer
Dim srcCell As Range
Dim dstCell As Range
Dim lr As Long
Dim cntr As Integer
Dim columnHeading As String
lr = LastRow(dstSheet) + 1 'Finds the last open row
Row = GetRow(srcSheet, sym) 'Get row no. from CONTRSPEC based on selection in list box
For cntr = 2 To LastRowOfColumn(transferRange)
columnHeading = transferRange.Cells(cntr, 1).Value
srcCol = GetCol(srcSheet, columnHeading)
dstCol = GetCol(dstSheet, columnHeading)
Set srcCell = srcRange.Cells(Row, srcCol)
Set dstCell = dstRange.Cells(lr, dstCol)
srcCell.Copy dstCell
Next
End Sub

Private Sub ListBox1_Click()
End Sub

Function GetRow(sh As Worksheet, colAValue As String) 'Returns row no. where "sym" is found
GetRow = sh.Cells.Find(What:=colAValue, _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End Function

Function GetCol(sh As Worksheet, colHeading As String) 'Returns col no. where "colName" is found
GetCol = sh.Cells.Find(What:=colHeading, _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End Function

Function LastRow(sh As Worksheet) 'Returns row no. of last empty row
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastRowOfColumn(columnRange As Range) 'Returns row no. of last empty row of col...
On Error Resume Next
LastRowOfColumn = columnRange.Find(What:="*", _
After:=columnRange.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastCol(sh As Worksheet) 'Returns column no. of last empty column
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

[sskappel]

I found solutions to my problems. I post working code below.

Problem 1 was just to remove some mental blocks. I found out that I can of course always search with type String.
Problem 2 was due to mistakes in Function GetRow.

'The purpose of this code is to transfer cells from one sheet to another.
'Cell selection is based on selecting one row, based on criteria in one column
'and selecting columns based on the headings in row 1 of the source sheet.
'Names of column headings to transfer cells from is listed in the 'transferSheet'
'By this I can change wich columns to transfer, without editing the vb-code

Option Explicit
 
Public rowIndx As String                    'Value to choose source row
Public rowIndxRange As Range                'The range to look for rowIndx
Public srcSheet As Worksheet                'Source sheet
Public dstSheet As Worksheet                'Destination sheet
Public transferSheet As Worksheet           'Transfer sheet w/ values of column headings
Public srcRange As Range
Public dstRange As Range
Public transferRange As Range
 
Sub CopyCellsByHeadings()
Dim Row As Integer
    Dim srcCol As Integer
    Dim dstCol As Integer
    Dim srcCell As Range
    Dim dstCell As Range
    Dim lr As Long
    Dim cntr As Integer
    Dim columnHeading As String
lr = LastRow(dstSheet) + 1               'Finds the last open row
    Row = GetRow(rowIndxRange, rowIndx)      'Get row no. from CONTRSPEC based on selection in list box
For cntr = 2 To LastRowOfColumn(transferRange)
        columnHeading = transferRange.Cells(cntr, 1).Value
        srcCol = GetCol(srcSheet, columnHeading)
        dstCol = GetCol(dstSheet, columnHeading)
        Set srcCell = srcRange.Cells(Row, srcCol)
        Set dstCell = dstRange.Cells(lr, dstCol)
        srcCell.Copy dstCell
    Next
End Sub
 
Private Sub SendButton_Click()
    'Settings:
    Set srcSheet = Worksheets("CONTRSPEC")
    Set dstSheet = Worksheets("LOG")
    Set transferSheet = Worksheets("RANGELISTS")
    Set transferRange = transferSheet.Range("A:A")
    Set srcRange = srcSheet.Range("A:XX")
    Set dstRange = dstSheet.Range("A:XX")
    rowIndx = ListBox1.Value                        'Gets value from list box selection
    Set rowIndxRange = srcSheet.Range("A:A")
CopyCellsByHeadings
End Sub
 
Private Sub ListBox1_Click()
End Sub
 
Function GetRow(columnRange As Range, colAValue As String)         'Returns row no. where "sym" is found
    GetRow = columnRange.Find(What:=colAValue, _
                            After:=columnRange.Cells(1, 1), _
                            Lookat:=xlWhole, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
End Function
 
Function GetCol(sh As Worksheet, colHeading As String)     'Returns col no. where "colHeading" is found
    GetCol = sh.Cells.Find(What:=colHeading, _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
End Function
 
Function LastRow(sh As Worksheet)                       'Returns row no. of last empty row
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Function LastRowOfColumn(columnRange As Range)                 'Returns row no. of last empty row of col...
    On Error Resume Next
    LastRowOfColumn = columnRange.Find(What:="*", _
                            After:=columnRange.Cells(1, 1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Function LastCol(sh As Worksheet)                       'Returns column no. of last empty column
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function