OFFSET LOOKUP function in VBA?

[ryasportscience]

Hi -

looking for a bit of guidance please. I am using a Userform to enter data into a database. Each database entry is entered as a new row and I have beenusing the following VBA code to specify the column and then find the next empty row to enter the data in.

I am trying (with not much success) to alter the code so that it finds the column header rather than specifying the column using RowCount - this is sothat if the database changes (I.e. a column added to somewhere in the middle) that the data will still be entered in the correct location.

In the example code below the first offset enters data into column A titled"Test Date"; offset 2 enters to column B titled "Test Time"; offset 3 enters to column C titled "name".



'Offset function to find the next blank cell from A1 for data inputs

RowCount = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count

With Worksheets("Data").Range("A1")
.Offset(RowCount, 0) = CDate(Me.txtTestDate.Value)
.Offset(RowCount, 1) = Me.ComboTime.Text
.Offset(RowCount, 2) = Me.txtName.Value


Thanks in advance

 

[Claus Busch]

Hi,

Am Thu, 3 Oct 2013 13:59:08 -0700 (PDT) schrieb
(e-mail address removed):

In the example code below the first offset enters data into column A titled "Test Date"; offset 2 enters to column B titled "Test Time"; offset 3 enters to column C titled "name".

name your headers like your activeX objects, e.g. textbox is named
"txtTestDate" so name the header "TestDate" and then try:

Dim FERow As Long 'First empty row
Dim c As Range

FERow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Me.txtTestDate
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = CDate(Me.txtTestDate.Value)
End With
and repeat the with statement for all your activeX objects


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Fri, 4 Oct 2013 13:20:58 +0200 schrieb Claus Busch:

Cells(FERow, c.Column) = CDate(Me.txtTestDate.Value)

a bit shorter:

Private Sub CommandButton1_Click()
Dim FERow As Long 'First empty row
Dim c As Range

FERow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Me.txtTestDate 'Header name is TestDate
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = CDate(.Value)
End With
With Me.cmbTestTime 'Header name is TestTime
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = .Text
End With
End Sub


Regards
Claus B.

 

[ryasportscience]

Hi thanks for the reply -

think I am almost there. Throws up a debug error and highlights : Cells(FERow, c.Column) = .Text

If I replace with the same as the first i.e. Cells(FERow, c.Column) = CDate(.Value) it appears to work fine.

What is this part of code stating? Sorry, not familiar with this line of code

Cheers

 

[Claus Busch]

Hi,

Am Fri, 4 Oct 2013 11:59:52 -0700 (PDT) schrieb
(e-mail address removed):

think I am almost there. Throws up a debug error and highlights : Cells(FERow, c.Column) = .Text

if your combo box is named "cmbTestTime" and the header "TestTime"
the code writes the combo box text into the first empty row in the
column of the searched header.

Regards
Claus B.

 

[ryasportscience]

Thanks for your help it has worked a treat!

Out of interest what does the CDate part of the code below refer to?

Cells(FERow, c.Column) = CDate(.Value)

I have been using this line of code in the following With statements with no apparent issues - but just want to check I have got this right

Cells(FERow, c.Column) = .Text

.... changing .text for . value where appropriate.

Really appreciate the time to respond! you have helped save many hours!!!

 

[Claus Busch]

Hi,

Am Sun, 6 Oct 2013 07:24:56 -0700 (PDT) schrieb
(e-mail address removed):

Out of interest what does the CDate part of the code below refer to?

Cells(FERow, c.Column) = CDate(.Value)

CDate will change a value to a Date.
In text boxes the values are text. To get the right dimension you can
change the text to your wished dimension, in this case to a date


Regards
Claus B.

 

[ryasportscience]

Thanks so much for your time

I learn something every time I post on here!!

 

[ryasportscience]

Sorry anther problem relating to this ....

I am getting an error after adding a number of these (I am using the formatbelow). The error I get is "Run Time error '1004' Method 'Range' of object'_worksheet' failed. Any ideas why this might be happening? I haven't changed anything else in the VBA code

With Me.txtAnthroInitials
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = .Text
End With

With Me.cmbAnthroTime
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = .Value
End With

 

[Claus Busch]

Hi,

Am Thu, 10 Oct 2013 04:23:27 -0700 (PDT) schrieb
(e-mail address removed):

With Me.txtAnthroInitials
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = .Text
End With

With Me.cmbAnthroTime
Set c = Worksheets("Data").Range("1:1") _
.Find(Right(.Name, Len(.Name) - 3), LookIn:=xlValues)
Cells(FERow, c.Column) = .Value
End With

I don't know your workbook. But I guess that the headers are not the
same as the objects name.


Regards
Claus B.