VBA Offset maintenance issue

[Baziwan]

I have a database & all information is added to the database via forms. The code uses offset to transfer entered information from textboxes into the relevent columns on the database.
My code works fine. However, several times a year the structure of the database alters (columns are added or removed). When alterations occur I have to go into vba and alter all the offsets.
This can be very time consuming. I've tried to look at ways to adjust the code so that it offsets to a named range by defining a column (eg. Column A defined as DBProductName) but I can't seem to get my head around how to correctly code it.
Below is a sample of the code I'm using that works if the columns are static. What I need is to adjust it to work with a more dynamic database. Any help would be fantastic.

Private Sub cmdAdd_Click()

Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Worksheets("Database")

With Me.txtProductName
        With ws.Range(Me.cbxVineyard & (Me.cbxCategory) & ("Sort")).Rows(1)
        On Error Resume Next
        .Offset(1, 0).EntireRow.Insert shift:=xlUp
        .Columns(1).Offset(1, 0).Value = Me.txtProductName.Value 'column A
        .Columns(1).Offset(1, 1).Value = Me.txtProductCode.Value 'column B
        .Columns(1).Offset(1, 4).Value = Me.cbxCountry.Value 'column E
        .Columns(1).Offset(1, 5).Value = Me.cbxVineyard.Value 'column F
        .Columns(1).Offset(1, 6).Value = Me.cbxVariety.Value 'column G
 End With
        ws.Range(Me.cbxVineyard & (Me.cbxCategory) & ("Sort")).Select
        Selection.Sort Key1:=Range(Me.cbxVineyard & (Me.cbxCategory) & ("Sort")), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End With
Application.ScreenUpdating = True
Unload Me
End Sub

Thanks in advance

Baziwan

 

[Yongle]

Like @Norie says, the offset is not required for the columns and instead you could use variable c for the column (instead of oSet) - I was too lazy to amend your code!
- the code would be amended to this

      Dim c As Long
[COLOR=#000080][I]'test headers exist[/I][/COLOR]        
           For Each hdr In arr
               On Error GoTo 0
               On Error Resume Next
            [COLOR=#ff0000]   c [/COLOR]= WorksheetFunction.Match(hdr, Sheets("Sheet1").Rows(1), 0)
               If Err.Number > 0 Then msg = msg & vbCr & hdr
            Next hdr
                If Len(msg) > 0 Then
                    MsgBox msg, vbExclamation, "MISSING FIELDS": GoTo TheEnd
                End If
[I][COLOR=#000080]'update cells[/COLOR][/I]
            .Offset(1, 0).EntireRow.Insert shift:=xlUp
            For Each hdr In arr
                [COLOR=#ff0000]c[/COLOR] = WorksheetFunction.Match(hdr, Sheets("Sheet1").Rows(1), 0)
                ctrl = WorksheetFunction.VLookup(hdr, Range("Fields"), 2, 0)
                [COLOR=#ff0000].Columns(c)[/COLOR].[COLOR=#ff0000]Offset(1)[/COLOR].Value = Me.Controls(ctrl).Value
            Next hdr

 

[Baziwan]

This looks really good Yongle. It would definitely make my code more streamlined & my database more dynamic. Got some Thanks for taking the time to do this, it' much appreciated.

 

[Yongle]

glad we helped, thanks for the feedback