Question

I have a quandary, and I don’t know if it will work better using excel VBA or not. Thinking about it I believe VBA will work best, but I don’t know how to make it work.

I have two pages in a workbook, one is the form, the other is the database, I want the pulldown menu from the form to populate the rest of the form. It does… what I want then is to be able to change the value of the form press submit, and the new data will overwrite the old data.

Is this possible?

Here is the link to the sheet I’m talking about.

http://dl.dropbox.com/u/3327208/Excel/Change.xlsx

Here is the script I am working with now…it takes the sheet, copies everything to a row takes that row, moves it to the NCMR Data tab and then clears the data on the new row from the original sheet.

This code technically could work, but what I need to do is make it use the same concept, but instead of creating a new row at the end of the sheet find the original line and replace the data from B to U in whatever row it was originally in.

I know it’s possible, I just don’t know how.

 'Copy Ranges Variable
    Dim c As Variant

    'Paste Ranges Variable
    Dim p As Range

    'Setting Sheet
    Set wsInt = Sheets("Form")
    Set wsNDA = Sheets("Data")
    Set p = wsInt.Range("A14")

    With wsInt
        c = Array(.Range("B11"))
    End With

    For i = LBound(c) To UBound(c)
        p(i + 1).Value = c(i).Value
    Next

    With wsNDA
        Dim Lastrow As Long

        Lastrow = .Range("B" & Rows.Count).End(xlUp).Row + 1

        wsInt.Rows("14").Copy

        With .Rows(Lastrow)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValues
            .Interior.Pattern = xlNone
        End With

        With .Range("A" & Lastrow)
            If Lastrow = 3 Then
                .Value = 1
            Else
                .Value = Val(wsNDA.Range("A" & Lastrow - 1).Value) + 1
            End If

            .NumberFormat = "0#######"
        End With
    End With
End Sub

I found this code:

Sub CopyTest()
Dim selrow As Range, rngToCopy As Range

With Worksheets("PD DB")
    Set selrow = .Range("B:B").Find(.Range("BA1").Value)
    'find the cell containing the value
    Set rngToCopy = Union(selrow.Offset(0, 9), selrow.Offset(0, 12))
    'use offset to define the ranges to be copied
    rngToCopy.Copy Destination:=Worksheets("Edit Sheet").Range("B50")
    'copy and paste (without Select)
End With

End Sub

As far as I can tell this will do what I want mostly, but I can’t seem to figure out where to break it up to add it where I need to to make it work the way I want it to.

What I can tell is this, it will copy and paste, but I want to make sure it will paste the data into row it finds, and not overwrite the number of said row.

Can someone help make that possible with the two scripts I have here?

Answer 1

Not tested, but should get you started. I added a 3rd sheet (shtMap) to hold the mmapping between the cell addresses on your form and the column numbers on the “Data” sheet. Useful to name your sheets directly in the VB editor: select the sheet and set the name in the property grid.

*EDIT:*If you want to trigger the transfer on selecting a record id from a list in Range AG3 then place this code in the code module for that worksheet:

Private Sub Worksheet_Change(ByVal Target As Range)

Static bProcessing As Boolean
Dim rng As Range

    If bProcessing Then Exit Sub
    Set rng = Target.Cells(1)
    If Not Application.Intersect(rng, Me.Range("AG3")) Is Nothing Then
        bProcessing = True
        'this is where you call your macro to transfer the record
        bProcessing = False
    End If

End Sub

You could use something like this for the transfer:

Public Enum XferDirection
    ToForm = 1
    ToDataSheet = 2
End Enum

Sub FetchRecord()
    TransferData XferDirection.ToForm
End Sub

Sub SaveRecord()
    TransferData XferDirection.ToDataSheet
End Sub


Sub TransferData(Direction As XferDirection)

    Dim rngMap As Range, rw As Range, f As Range, dataCell As Range
    Dim formCell As Range, dataCol As Long, dataRow As Long
    Dim sId As String

    sId = shtForm.Range("AG3").Value
    Set f = shtData.Columns(1).Find(sId, LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        dataRow = f.Row
    Else
        'what do you want to do here?
        '  record doesn't exist on data sheet
        MsgBox "Record '" & sId & "' not found on '" & shtForm.Name & "' !"
        Exit Sub
    End If

    Set rngMap = shtMap.Range("A2:B10")

    For Each rw In rngMap.Rows
        'the cell on the edit form
        Set formCell = shtForm.Range(rw.Cells(1).Value)
        'column # on datasheet
        Set dataCell = shtData.Cells(dataRow, rw.Cells(2).Value)

        If Direction = XferDirection.ToDataSheet Then
            dataCell.Value = formCell.Value
        Else
            formCell.Value = dataCell.Value
        End If
    Next rw

End Sub