Sub CopyData()
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim s As Long
Dim c As Long
Dim n As Long
Dim t As Long
Dim d As Long
Dim m As Long
Dim rng As Range
Dim v As String
Dim arr1
Dim arr2
Dim vis(1 To 39) As Boolean
Application.ScreenUpdating = False
' Modify the name of the workbook and the worksheet
' The code assumes that both workbooks are already open in Excel.
Set wsh1 = Workbooks("Workbook.xlsm").Worksheets("Sheet.1")
Set wsh2 = Workbooks("Workbook.xlsm").Worksheets("Sheet.2 (Data)")
Set rng = wsh1.Range("B:B")
For c = 1 To 39
vis(c) = Not wsh2.Cells(1, c).EntireColumn.Hidden
Next c
arr2 = wsh2.UsedRange.Value
m = UBound(arr2, 1)
ReDim arr1(1 To m, 1 To 16)
For s = 2 To m
v = arr2(s, 2)
If rng.Find(What:=v, LookAt:=xlWhole) Is Nothing Then
t = t + 1
d = 0
For c = 1 To 39 ' AM is column 39
If vis(c) Then
d = d + 1
arr1(t, d) = arr2(s, c)
End If
Next c
End If
Next s
If t = 0 Then
MsgBox "No new data!", vbInformation
Else
n = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row + 1
wsh1.Range("A" & n).Resize(m, 16).Value = arr1
MsgBox "Finished importing new data!", vbInformation
End If
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Something went wrong!", vbCritical
Resume ExitHandler
End Sub
mr hans i tried the code, unfortunately it will not work with big data [very large data], it gave me errors
anyway, i will PM you both of the original files because they have Sensitive information
,you can check both of the files by your self to fix what ever that need to be fixed, and to see how the code will work in my files
thanks in advance i will be waiting for your reply here,
This version works for me (I altered the names of the workbooks/worksheets), but it takes extremely long and then reports that there are no new data. I don't know how to speed it up.
Sub CopyData()
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim s As Long
Dim c As Long
Dim n As Long
Dim t As Long
Dim d As Long
Dim m As Long
Dim rng As Range
Dim v As String
Dim arr1
Dim arr2
Dim arr3
Dim vis(1 To 39) As Boolean
On Error GoTo ErrHandler
Application.ScreenUpdating = False
' Modify the name of the workbook and the worksheet
' The code assumes that both workbooks are already open in Excel.
Set wsh1 = Workbooks("Book1.xls").Worksheets("Sheet1")
Set wsh2 = Workbooks("Book2.xls").Worksheets("Sheet2")
Set rng = wsh1.Range("B:B")
For c = 1 To 39
vis(c) = Not wsh2.Cells(1, c).EntireColumn.Hidden
Next c
arr2 = wsh2.UsedRange.Value
m = UBound(arr2, 1)
ReDim arr1(1 To m, 1 To 16)
For s = 2 To m
v = arr2(s, 2)
If rng.Find(What:=v, LookAt:=xlWhole) Is Nothing Then
t = t + 1
d = 0
For c = 1 To 39 ' AM is column 39
If vis(c) Then
d = d + 1
arr1(t, d) = arr2(s, c)
End If
Next c
End If
Next s
If t = 0 Then
MsgBox "No new data!", vbInformation
Else
ReDim arr3(1 To t, 1 To 16)
For s = 1 To t
For c = 1 To 16
arr3(s, c) = arr1(s, c)
Next c
Next s
n = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row + 1
wsh1.Range("A" & n).Resize(t, 16).Value = arr3
MsgBox "Finished importing new data!", vbInformation
End If
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Something went wrong!", vbCritical
Resume ExitHandler
End Sub
HansV wrote:This version works for me (I altered the names of the workbooks/worksheets), but it takes extremely long and then reports that there are no new data. I don't know how to speed it up.
Sub CopyData()
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim s As Long
Dim c As Long
Dim n As Long
Dim t As Long
Dim d As Long
Dim m As Long
Dim rng As Range
Dim v As String
Dim arr1
Dim arr2
Dim arr3
Dim vis(1 To 39) As Boolean
On Error GoTo ErrHandler
Application.ScreenUpdating = False
' Modify the name of the workbook and the worksheet
' The code assumes that both workbooks are already open in Excel.
Set wsh1 = Workbooks("Book1.xls").Worksheets("Sheet1")
Set wsh2 = Workbooks("Book2.xls").Worksheets("Sheet2")
Set rng = wsh1.Range("B:B")
For c = 1 To 39
vis(c) = Not wsh2.Cells(1, c).EntireColumn.Hidden
Next c
arr2 = wsh2.UsedRange.Value
m = UBound(arr2, 1)
ReDim arr1(1 To m, 1 To 16)
For s = 2 To m
v = arr2(s, 2)
If rng.Find(What:=v, LookAt:=xlWhole) Is Nothing Then
t = t + 1
d = 0
For c = 1 To 39 ' AM is column 39
If vis(c) Then
d = d + 1
arr1(t, d) = arr2(s, c)
End If
Next c
End If
Next s
If t = 0 Then
MsgBox "No new data!", vbInformation
Else
ReDim arr3(1 To t, 1 To 16)
For s = 1 To t
For c = 1 To 16
arr3(s, c) = arr1(s, c)
Next c
Next s
n = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row + 1
wsh1.Range("A" & n).Resize(t, 16).Value = arr3
MsgBox "Finished importing new data!", vbInformation
End If
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Something went wrong!", vbCritical
Resume ExitHandler
End Sub
Mr.hans thats what i was talking about [the error], there are new data , but the code is unable to import them !! , i tried several times, but it keeps telling me "No New Data"
HansV wrote:This version works for me (I altered the names of the workbooks/worksheets), but it takes extremely long and then reports that there are no new data. I don't know how to speed it up.
Sub CopyData()
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim s As Long
Dim c As Long
Dim n As Long
Dim t As Long
Dim d As Long
Dim m As Long
Dim rng As Range
Dim v As String
Dim arr1
Dim arr2
Dim arr3
Dim vis(1 To 39) As Boolean
On Error GoTo ErrHandler
Application.ScreenUpdating = False
' Modify the name of the workbook and the worksheet
' The code assumes that both workbooks are already open in Excel.
Set wsh1 = Workbooks("Book1.xls").Worksheets("Sheet1")
Set wsh2 = Workbooks("Book2.xls").Worksheets("Sheet2")
Set rng = wsh1.Range("B:B")
For c = 1 To 39
vis(c) = Not wsh2.Cells(1, c).EntireColumn.Hidden
Next c
arr2 = wsh2.UsedRange.Value
m = UBound(arr2, 1)
ReDim arr1(1 To m, 1 To 16)
For s = 2 To m
v = arr2(s, 2)
If rng.Find(What:=v, LookAt:=xlWhole) Is Nothing Then
t = t + 1
d = 0
For c = 1 To 39 ' AM is column 39
If vis(c) Then
d = d + 1
arr1(t, d) = arr2(s, c)
End If
Next c
End If
Next s
If t = 0 Then
MsgBox "No new data!", vbInformation
Else
ReDim arr3(1 To t, 1 To 16)
For s = 1 To t
For c = 1 To 16
arr3(s, c) = arr1(s, c)
Next c
Next s
n = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row + 1
wsh1.Range("A" & n).Resize(t, 16).Value = arr3
MsgBox "Finished importing new data!", vbInformation
End If
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Something went wrong!", vbCritical
Resume ExitHandler
End Sub
Note: all the colored numbers are new data supposed to be filled by using the code
MR. hans i have questions, about Access. and Excel, as you can see in this Topic, excel was not able to manipulate such a massive data ( 40000 Records ) using VBA , it will be VERY slow, and some time like my case the code will just fail, now my questions are,
- will Access be able to handle and manipulate such a massive data!?
if the VBA in access will fail same as Excel i don't want to waste my time learning access
- will access be fast in handle and manipulate such amount of data!!?
if access will not be effective please inform me and give me some advice
Access is a much better application for this. You can probably use an append query for your purpose instead of VBA. Such a query would be much faster than using Excel.
HansV wrote:Access is a much better application for this. You can probably use an append query for your purpose instead of VBA. Such a query would be much faster than using Excel.
