Issues copying data to another sheet

jynxy

New Member
Joined
Feb 13, 2022
Messages
32
Office Version
  1. 2019
Platform
  1. Windows
Hi,

Really having issues copying data to another sheet, i have tried copy/paste, copy dest, value = value, array etc. i have also tried all the manual calculation, nodisplayalerts and all the other usual things. When running on a non shared workbook with others, it works perfect no issues can run as many times as you wanted instantly, soon i share the workbook with others, thats when the fun begins, usually the first time it will run fine and fairly quick, the second time onwards, i could go and make myself a cup of tea/coffee before it completes. the status bar shows filling cells and the turtle with a pencil comes out writing out the cells. i have spent the last week pulling my hair out and searching all over the web and cannot find anything.

I have tried creating a new sheet incase there was an issue with the old still the same, tried disabling track history, on the local HDD, on the network, original i was copying from another workbook, so i have tried in the same workbook, all the same. below is the latest code im trying, i dont fully understand it as not used arrays before, but seems to work no shared. i will eventually have this putting data on multiple sheets, on a for loop somehow, but at the moment i need to get it working on one sheet. What am i missing ? seems like its not closing of previous run.

VBA Code:
Sub CopyDetails()
 
    Windows("ArrayCopy1.xlsm").Activate
    Dim rng As Range
    Dim arrS1, arrD1
    Dim lRow As Long
    Dim i1 As Long, ct1 As Long
  
    Dim wb As Workbook
    Set wb = ThisWorkbook 'source workbook
    Dim ws As Worksheet
    Dim tws1 As Worksheet
  
    Set ws = wb.Sheets("Data") 'source worksheet
    Set tws1 = wb.Sheets("Sheet1") 'target worksheet
  
    Date1 = Format("23/09/2023", "MM/DD/YYYY")
  
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
  
    ct1 = 1
  
    With ws
        arrS1 = .Range("A2:G" & lRow)
        ReDim arrD1(1 To UBound(arrS1), 1 To 7)
        For i1 = 1 To UBound(arrS1)
            If Format(arrS1(i1, 5), "MM/DD/YYYY") = Date1 Then
                arrD1(ct1, 1) = arrS1(i1, 1)
                arrD1(ct1, 2) = arrS1(i1, 2)
                arrD1(ct1, 3) = arrS1(i1, 3)
                arrD1(ct1, 4) = arrS1(i1, 4)
                arrD1(ct1, 5) = arrS1(i1, 5)
                arrD1(ct1, 6) = arrS1(i1, 6)
                arrD1(ct1, 7) = arrS1(i1, 7)
                ct1 = ct1 + 1
            End If
        Next
    End With

    With tws1
        .Range("A1").Resize(UBound(arrD1, 1), UBound(arrD1, 2)) = arrD1
        ReDim arrD1(1 To UBound(arrS1), 1 To 1)
    End With

Erase arrS1
Erase arrD1
Set wb = Nothing
Set ws = Nothing
Set tws1 = Nothing
Set rng = Nothing
 
End Sub

Sample data


Excel Formula:
[TABLE]
[TR]
[TD]Site[/TD]
[TD]Emp #[/TD]
[TD]FirstName[/TD]
[TD]LastName[/TD]
[TD]InTimestamp[/TD]
[TD]OutTimestamp[/TD]
[TD]ScheduledShiftID[/TD]
[/TR]
[TR]
[TD][RIGHT]1234[/RIGHT][/TD]
[TD][RIGHT]987654321[/RIGHT][/TD]
[TD]Joe[/TD]
[TD]Bloggs[/TD]
[TD][RIGHT]26/09/2023 10:00[/RIGHT][/TD]
[TD][RIGHT]26/09/2023 16:00[/RIGHT][/TD]
[TD][RIGHT]11456259[/RIGHT][/TD]
[/TR]
[TR]
[TD][RIGHT]1234[/RIGHT][/TD]
[TD][RIGHT]876543210[/RIGHT][/TD]
[TD]Jane[/TD]
[TD]Doe[/TD]
[TD][RIGHT]29/09/2023 10:00[/RIGHT][/TD]
[TD][RIGHT]29/09/2023 16:00[/RIGHT][/TD]
[TD][RIGHT]11456261[/RIGHT][/TD]
[/TR]
[TR]
[TD][RIGHT]1234[/RIGHT][/TD]
[TD][RIGHT]765432109[/RIGHT][/TD]
[TD]Captin[/TD]
[TD]America[/TD]
[TD][RIGHT]03/10/2023 10:00[/RIGHT][/TD]
[TD][RIGHT]03/10/2023 16:00[/RIGHT][/TD]
[TD][RIGHT]11485315[/RIGHT][/TD]
[/TR]
[/TABLE]
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
im still having no luck, if i close and reopen excel it will run again, i have tried creating a second macro with different variable names etc, i run the first code and then i run the second code, this still does the same and runs very slow, logic for this was thinking it was not clearing correctly, but if all different then should run again quick. seems like something is not completing and by either unsharing and sharing again or restarting the file, seems to clear this, any ideas ?
 
Upvote 0
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Issues copying data to another sheet
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0
Sorry about that, if i ever find the solution which is not on here i will be sure to post the answer to help others. There is nothing worse than seeing resolved but not knowing how.
 
Upvote 0

Forum statistics

Threads
1,215,113
Messages
6,123,165
Members
449,099
Latest member
afishi0nado

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top