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").Lis开发者_Go百科tObjects("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
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 ;))
精彩评论