All, Im trying to pull data from a sheet and sort it into a table on a secondary sheet. THe data is transfering over, but its not move to the first row in the table and working down. It appears to skip the first row. I've also created a clear form button. Whne I run this macro it clears the data, but if I run the data pull macro, it pulls it to the bottom of where the last information was deleted.
2 questions in conclusionl;
1. Why isnt the information transfering into the tables first row and working down?
2. Why after i use the delete function does the data continue from the end of the last item that was deleted?
VBA script below;
2 questions in conclusionl;
1. Why isnt the information transfering into the tables first row and working down?
2. Why after i use the delete function does the data continue from the end of the last item that was deleted?
VBA script below;
VBA Code:
Option Explicit
Sub test()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim LastRowSource As Long, LastRowDestination As Long
Dim i As Long, y As Long
Dim Value_1 As String, Value_2 As String
Dim ValueExists As Boolean
With ThisWorkbook
Set wsSource = .Worksheets("Data Dump")
Set wsDestination = .Worksheets("Calc")
End With
With wsSource
'Find the last row of Column A, wsSource
LastRowSource = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop Column A, wsSource
For i = 1 To LastRowSource
'Testing Columns F & G
Value_1 = .Range("F" & i).Value
Value_2 = .Range("G" & i).Value
ValueExists = False
With wsDestination
Dim tblInv As ListObject
Set tblInv = .ListObjects("Table3")
'Find the last row of Column A, wsDestination
LastRowDestination = tblInv.Range.Offset.Rows.Count
'Loop Column A, wsDestination
For y = 1 To LastRowDestination
If .Range("A" & y).Offset(2).Value = Value_1 And .Range("B" & y).Value = Value_2 Then
ValueExists = True
Exit For
End If
Next y
'If value does not exist copy
If ValueExists = False Then
.Range("F" & LastRowDestination + 1).Value = Value_1
.Range("A" & LastRowDestination + 1).Value = Value_2
.Range("B" & LastRowDestination + 1).Value = wsSource.Range("L" & i).Value
.Range("D" & LastRowDestination + 1).Value = wsSource.Range("R" & i).Value
.Range("E" & LastRowDestination + 1).Value = wsSource.Range("D" & i).Value
.Range("G" & LastRowDestination + 1).Value = wsSource.Range("H" & i).Value
.Range("I" & LastRowDestination + 1).Value = wsSource.Range("C" & i).Value
.Range("J" & LastRowDestination + 1).Value = wsSource.Range("V" & i).Value
.Range("K" & LastRowDestination + 1).Value = wsSource.Range("M" & i).Value
.Range("M" & LastRowDestination + 1).Value = "=VLOOKUP($L2,Defects2!Print_Area,2,FALSE)"
.Range("O" & LastRowDestination + 1).Value = wsSource.Range("N" & i).Value
.Range("R" & LastRowDestination + 1).Value = wsSource.Range("O" & i).Value
.Range("S" & LastRowDestination + 1).Value = wsSource.Range("P" & i).Value
End If
End With
Next i
End With
End Sub
Sub test2()
With Sheets("Calc").ListObjects("Table3")
If Not .DataBodyRange Is Nothing Then
'Clear contents of table
.DataBodyRange.ClearContents
End If
End With
End Sub