Absolute Reference with VBA to database

[jerrystuart16]

Hello

In my example, I have a list of fields (name, address, phone, etc.) that I transfer from an inputs worksheet and use VBA button to save it to another sheet for the database reference.

So, it starts at J5.
Then it is on other columns on the sheets.

And there are a few locations for inputs in different columns and rows on this sheet.

But if I add rows or columns and move the worksheet where the source data is from, then it doesn't get transferred over, because the cell references have changed.

Is there a solution for this?

Here is my VBA code:

--

Private Sub Button29_Click()
erw = Sheet10.Cells(1, 1).CurrentRegion.Rows.Count + 1


If Len(Range("J5")) <> 0 Then
Sheet10.Cells(erw, 1) = Range("J5")
Sheet10.Cells(erw, 2) = Range("J6")
Sheet10.Cells(erw, 3) = Range("J7")
Sheet10.Cells(erw, 4) = Range("J8")
Sheet10.Cells(erw, 5) = Range("J9")
Sheet10.Cells(erw, 6) = Range("J10")
Sheet10.Cells(erw, 7) = Range("J11")
Sheet10.Cells(erw, 8) = Range("J12")
Sheet10.Cells(erw, 9) = Range("J13")
Sheet10.Cells(erw, 10) = Range("J14")
Sheet10.Cells(erw, 11) = Range("J16")
Sheet10.Cells(erw, 12) = Range("J15")
Sheet10.Cells(erw, 13) = Range("C9")
Sheet10.Cells(erw, 14) = Range("C25")
Sheet10.Cells(erw, 15) = Range("C19")
Sheet10.Cells(erw, 16) = Range("C20")
Sheet10.Cells(erw, 17) = Range("C21")
Sheet10.Cells(erw, 18) = Range("C22")
Sheet10.Cells(erw, 19) = Range("C31")
Sheet10.Cells(erw, 20) = Range("F33")
Sheet10.Cells(erw, 21) = Range("K27")
Sheet10.Cells(erw, 22) = Range("K28")
Sheet10.Cells(erw, 23) = Range("K29")
Sheet10.Cells(erw, 24) = Range("K30")
Sheet10.Cells(erw, 25) = Range("K31")
Sheet10.Cells(erw, 26) = Range("K32")
Sheet10.Cells(erw, 27) = Range("G40")
Sheet10.Cells(erw, 28) = Range("G38")
Sheet10.Cells(erw, 29) = Range("G39")
Sheet10.Cells(erw, 30) = Range("C71")
Sheet10.Cells(erw, 31) = Range("K53")
Sheet10.Cells(erw, 32) = Range("K60")
Sheet10.Cells(erw, 33) = Range("K13")












Else:
MsgBox "You must enter a name and contact info"
End If

--

Thanks!

 

[dmt32]

Not sure I fully follow your issue but you can declare an input range made up of contiguous & non-contiguous cells & pass their values to a dynamic array which outputs to your database.

Example

  Private Sub Button29_Click()    
    Dim DataEntryRange As Range, Cell As Range
    Dim wsDatabase As Worksheet
    Dim DataArray() As Variant
    Dim i As Integer
    Dim erw As Long
    
'database worksheet
    Set wsDatabase = Sheet10
'data entry input range
    Set DataEntryRange = ThisWorkbook.Worksheets("Sheet1").Range("J5:J14,J16:J15,C9,C25,C19:C22,C31,F33," & _
                                                                 "K27:K32,G40,G38:G39,C71,K53,K60,K13")
'check entry in J5
    If Len(DataEntryRange.Cells(1, 1).Value) = 0 Then
        MsgBox "You must enter a name and contact info", 48, "Entry Required"
    Else
'size array
        ReDim DataArray(1 To DataEntryRange.Cells.Count)
'populate array elements
        For Each Cell In DataEntryRange.Cells
'array element counter
            i = i + 1
            DataArray(i) = Cell.Value
        Next Cell
'apply array to database
        With wsDatabase
            erw = .Cells(1, 1).CurrentRegion.Rows.Count + 1
            .Cells(erw, 1).Resize(1, UBound(DataArray)) = DataArray
        End With
    End If
End Sub

Change data entry sheet name shown in RED as required.

As you are working with different sheets always a good idea to qualify the ranges to correct worksheet.

Hope Helpful

Dave

 

[jerrystuart16]

Hello David

Thanks for your response.

What my question was, is when you add a row or a column in excel, after this has been programmed into VBA, and the rows and columns shift 1 or 2 cells, that those references are no longer valid.

Like if I added a row and now J5 becomes J4 and I miss that cell.

So is there a way to "follow" the changes in VBA?

Thanks!

 

[dmt32]

Hello David

Thanks for your response.

What my question was, is when you add a row or a column in excel, after this has been programmed into VBA, and the rows and columns shift 1 or 2 cells, that those references are no longer valid.

Like if I added a row and now J5 becomes J4 and I miss that cell.

So is there a way to "follow" the changes in VBA?

Thanks!

Not something I have ever given consideration to but one idea maybe, would be to place your input ranges in the name manager


then instead of having hard code cell addresses like below

'data entry input range
    Set DataEntryRange = ThisWorkbook.Worksheets("Sheet1").Range("J5:J14,J16:J15,C9,C25,C19:C22,C31,F33," & _
                                                                 "K27:K32,G40,G38:G39,C71,K53,K60,K13")

You would specify the named range

'data entry input range
    Set DataEntryRange = ThisWorkbook.Worksheets("Sheet1").Range("DataEntryNameRange")

Perhaps then when you insert row / column - excel would keep "track" of your input ranges. but you would need to test idea to see if suggestion will do what you want.

Dave

 

[jerrystuart16]

David

That is a simple and now I believe, the best path to avoid changes to any worksheet!

Great suggestion =)

Many thanks!!

 

[jerrystuart16]

David,

Sorry didn't share, but it works!
Thanks!

On another question: how can I send this data to 2 separate worksheets in the same workbook?

Want them to go to their own tables.

With my button, unclear on the code to write to send them to another sheet.

Thanks again!

 

[dmt32]

David,

On another question: how can I send this data to 2 separate worksheets in the same workbook?

Want them to go to their own tables.

With my button, unclear on the code to write to send them to another sheet.

Thanks again!

You can try following changes

replace this part of the code

'apply array to database
        With wsDatabase
            erw = .Cells(1, 1).CurrentRegion.Rows.Count + 1
            .Cells(erw, 1).Resize(1, UBound(DataArray)) = DataArray
        End With

with this

'apply array to tables
    For Each wsDatabase In ThisWorkbook.Worksheets(Array("Sheet2", "Sheet3"))
        With wsDatabase
            erw = .Cells(1, 1).CurrentRegion.Rows.Count + 1
            .Cells(erw, 1).Resize(1, UBound(DataArray)) = DataArray
        End With
    Next wsDatabase

Change sheet names shown in RED as required

delete this line

Set wsDatabase = Sheet10

and see if these changes do what you want

Dave

 

[jerrystuart16]

Hi Dave

Well getting the old runtime error 9, subscript out of range for this:

Now I did name range and tried just 2 name ranges and it also created the error.

Suggestions?

Thank you!

'data entry input range
Set DataEntryRange = ThisWorkbook.Worksheets("Sheet1").Range("J5:J14,J16:J15,C9,C25,C19:C22,C31,F33," & _
"K27:K32,G40,G38:G39,C71,K53,K60,K13")

 

[dmt32]

Hi Dave

Well getting the old runtime error 9, subscript out of range for this:

Now I did name range and tried just 2 name ranges and it also created the error.

Suggestions?

Thank you!

'data entry input range
Set DataEntryRange = ThisWorkbook.Worksheets("Sheet1").Range("J5:J14,J16:J15,C9,C25,C19:C22,C31,F33," & _
"K27:K32,G40,G38:G39,C71,K53,K60,K13")

Error Suggests Sheet1 does not exist.

Dave

 

[jerrystuart16]

Dave

I did edit it to the correct worksheet, which is the sheet the data will eventually go to, which is sheet 10.
When I do F8, this is where the error is coming from.
Tried to remove all cell references down to one to see if that was it.
Tried name range and actual cell reference.

Any other suggestions?

Thanks~
--

'data entry input range
Set DataEntryRange = ThisWorkbook.Worksheets("Sheet10").Range("J5:J14,J16:J15,C9,C25,C19:C22,C31,F33," & _
"K27:K32,G40,G38:G39,C71,K53,K60,K13")

Here is the full VBA:

Dim DataEntryRange As Range, Cell As Range
Dim wsDatabase As Worksheet
Dim DataArray() As Variant
Dim i As Integer
Dim erw As Long

'database worksheet
Set wsDatabase = Sheet10
'data entry input range
Set DataEntryRange = ThisWorkbook.Worksheets("Sheet10").Range("J5:J14,J16:J15,C9,C25,C19:C22,C31,F33," & _
"K27:K32,G40,G38:G39,C71,K53,K60,K13")
'check entry in J5
If Len(DataEntryRange.Cells(1, 1).Value) = 0 Then
MsgBox "You must enter a name and contact info", 48, "Entry Required"
Else
'size array
ReDim DataArray(1 To DataEntryRange.Cells.Count)
'populate array elements
For Each Cell In DataEntryRange.Cells
'array element counter
i = i + 1
DataArray(i) = Cell.Value
Next Cell
'apply array to database
With wsDatabase
erw = .Cells(1, 1).CurrentRegion.Rows.Count + 1
.Cells(erw, 1).Resize(1, UBound(DataArray)) = DataArray
End With
End If
End Sub