Peaches491 Peaches491 - 28 days ago 15
SQL Question

VBA retain info after database synchronisation

So, in a Workbook, I have two worksheets: One has a table full of ideas which is linked to an

SQL
database, and the other will have certain ideas selected from that table.

From the database table, I want to copy ideas that meet specific criteria to a second table. There they will be given certain numerical rankings by the user

Idea 1 0 4 5 3 8
Idea 2 7 5 1 5 4
Idea 3 1 2 8 8 2


Upon the clock of an included button, i want to update the database table, and copy over any NEW ideas into the ratings table, so that it may resemble the following.

Idea 1 0 4 5 3 8
Idea 2 7 5 1 5 4
Idea 3 1 2 8 8 2
New Idea1
New Idea2


How can I accomplish this copying? I can't imagine a way to do this without overwriting the already included ratings.

Code



Code used to copy all ID numbers to rating table.

Sub CopyFilter()

Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Set rng = Worksheets("Ideas").ListObjects("IdeasTable"). _
ListColumns(1).DataBodyRange
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy

Worksheets("WFNs").Range("B5").PasteSpecial Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

ActiveSheet.ShowAllData
Worksheets("WFNs").Activate

End Sub

Answer

What you have to do is, save the information about what you inserted. First, declare a global variable like this:

Dim startRow as Long

In your sub:

If startRow = 0 Then
    startRow = 1 
End If 

With ActiveSheet.AutoFilter.Range
    On Error Resume Next
        Set rng2 = .Offset(startRow, 0).Resize(.Rows.Count - 1, 1) _
            .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

Instead of always copying the whole range, you only copy the new entries. Now that you have the starting row, you can use that in your if to paste your data AFTER the old date:

Else
    Set rng = Worksheets("Ideas").ListObjects("IdeasTable"). _
        ListColumns(1).DataBodyRange
    rng.Offset(startRow, 0).Resize(rng.Rows.Count - 1).Copy

    Worksheets("WFNs").Range("B" & (startRow + 4)).PasteSpecial Paste:=xlPasteFormulas, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    startRow = rng.Rows.Count - 1
End If

I only changed rows with startRow in it. (Not tested ;))