My code implementation hangs indefinitely and messes up the destination workbook

s3a

New Member
Joined
Nov 15, 2012
Messages
1
Hello to people who read this.

My code implementation hangs indefinitely (or so it seems) and messes up (at least) the destination workbook.

Here is my macro.:
Code:
Sub UpdatePeopleHours()

    Dim firstRowSrc, lastRowSrc, firstRowDest, lastRowDest, firstColumnDest, lastColumnDest, beforeFrenchTimeInterval, beginningBeforeFrenchTimeInterval, endingBeforeFrenchTimeInterval, columnOfPersonDest, columnOfSAndP, columnOfLQ, columnOfProject, currentRowSrc, currentPersonSkill, currentColumnDest, currentRowDest As Long
    Dim wsSrc, wsDest1, wsDest2 As Worksheet
    Dim frenchHour, currentPersonSrc As String
    
    Set wsSrc = Workbooks("the_larger_file.xlsm").Sheets(1)
    Set wsDest1 = ThisWorkbook.Sheets(1)
    Set wsDest2 = ThisWorkbook.Sheets(2)
    
    firstRowSrc = wsDest2.Range("B3").Value
    lastRowSrc = wsSrc.Range("A:A").Find("*", Range("A1"), SearchDirection:=xlPrevious).Row
    
    lastColumnDest = wsDest1.Cells(1, 1).End(xlToLeft).Column

    For currentRowSrc = firstRowSrc To lastRowSrc
        
        currentPersonSrc = wsSrc.Cells(currentRowSrc, 11).Value
        currentPersonSkill = wsSrc.Cells(currentRowSrc, 5).Value
        
        columnOfPersonDest = -1
        
        For currentColumnDest = 11 To lastColumnDest 'This for loop finds out which column (the row is constant) the name of a person already added is at in dest ws as well as columns for "S&P", "Loto-Quebec", and "Project"
            
            If wsDest1.Cells(1, currentColumnDest) = wsSrc.Cells(currentRowSrc, 11) Then
                columnOfPersonDest = currentColumnDest
            End If
            
            If wsDest1.Cells(1, currentColumnDest) = "S&P" Then
                columnOfSAndP = currentColumnDest
            End If
            
            If wsDest1.Cells(1, currentColumnDest) = "Loto Quebec" Then
                columnOfLQ = currentColumnDest
            End If
            
            If wsDest1.Cells(1, currentColumnDest) = "Project" Then
                columnOfProject = currentColumnDest
            End If
            
        Next currentColumnDest
        
        If columnOfPersonDest = -1 Then 'In other words, if the person in the src ws was not found in the dest ws
            If wsSrc.Cells(currentRowSrc, 5) = "LQ" Then
                wsDest1.Range(wsDest1.Cell(1, columnOfLQ + 1), wsDest1.Cell(1, lastColumnDest)).Copy wsDest1.Range(wsDest1.Cell(1, columnOfLQ + 2), wsDest1.Cell(1, lastColumnDest + 1)) 'shift all columns from beyond columnOfLQ by 1 column and place the name of the person from wsSrc.Cell(currentRowSrc, 11) into wsDest1.Cell(currentRowDest, columnOfLQ+1)
                lastColumnDest = lastColumnDest + 1 'Increment by one since I'm adding a column when shifting and storing new person from previous line
                
            Else 'if it's S&P or anything other than LQ
                wsDest1.Range(wsDest1.Cells(1, columnOfSAndP + 1), wsDest1.Cells(1, lastColumnDest)).Copy wsDest1.Range(wsDest1.Cells(1, columnOfSAndP + 2), wsDest1.Cells(1, lastColumnDest + 1)) 'shift all columns from beyond columnOfSAndP by 1 column and place the name of the person from wsSrc.Cells(currentRowSrc, 11) into wsDest1.Cells(currentRowDest, columnOfSAndP+1)
                lastColumnDest = lastColumnDest + 1 'Increment by one since I'm adding a column when shifting and storing new person from previous line
            End If          
            
        End If
        
        firstRowDest = wsDest2.Range("B4").Value
        
        For currentRowDest = firstRowDest To lastRowDest
        
            beforeFrenchTimeInterval = 600
            frenchHour = Left(Format(beforeFrenchTimeInterval, "0000"), 2) & ":" & Mid(Format(beforeFrenchTimeInterval, "0000"), 3)
            
            If CDbl(beforeFrenchTimeInterval / 100) = Round(CDbl(beforeFrenchTimeInterval / 100)) Then
                beforeFrenchTimeInterval = beforeFrenchTimeInterval + 30
            Else
                beforeFrenchTimeInterval = beforeFrenchTimeInterval - 30 + 100
            End If
            
            wsDest1.Cells(currentRowDest, 1) = wsSrc.Cells(currentRowSrc, 1) 'write the date taken from src: currentRowSrc and column A aka 1
            wsDest1.Cells(currentRowDest, 2) = wsSrc.Cells(currentRowSrc, 2) 'write the day in currentRowDest and column B aka 2
            wsDest1.Cells(currentRowDest, 3) = frenchHour 'write the time in currentRowDest and column C aka 3
                        
            If wsSrc.Cell(currentRowSrc, 12).Value <> 0 Or wsSrc.Cell(currentRowSrc, 20).Value <> 0 Then
                
                If wsSrc.Cell(currentRowSrc, 12).Value <> 0 And wsSrc.Cell(currentRowSrc, 20).Value <> 0 Then
                    
                    If wsSrc.Cell(currentRowSrc, 12).Value > wsSrc.Cell(currentRowSrc, 20).Value Then
                        beginningBeforeFrenchTimeInterval = wsSrc.Cell(currentRowSrc, 20).Value
                    Else
                        beginningBeforeFrenchTimeInterval = wsSrc.Cell(currentRowSrc, 12).Value
                    End If
                    
                End If
            
            End If
            If wsSrc.Cell(currentRowSrc, 13).Value <> 0 Or wsSrc.Cell(currentRowSrc, 21).Value <> 0 Then
                
                If wsSrc.Cell(currentRowSrc, 13).Value <> 0 And wsSrc.Cell(currentRowSrc, 21).Value <> 0 Then
                    
                    If wsSrc.Cell(currentRowSrc, 13).Value > wsSrc.Cell(currentRowSrc, 21).Value Then
                        beginningBeforeFrenchTimeInterval = wsSrc.Cell(currentRowSrc, 13).Value
                    Else
                        beginningBeforeFrenchTimeInterval = wsSrc.Cell(currentRowSrc, 21).Value
                    End If
                    
                End If
            
            End If
            
            If beforeFrenchTimeInterval >= beginningBeforeFrenchTimeInterval Or beforeFrenchTimeInterval <= endingBeforeFrenchTimeInterval Then
                wsDest1.Cell(currentRowDest, columnOfPersonDest) = "W"
            End If
            
        Next currentRowDest
        
        beforeFrenchTimeInterval = 600
        
    Next currentRowSrc
    
    wsDest2.Range("B3").Value = lastRowSrc + 1 'set the data in sheet 2 of dest file beginning firstRowSrc of next time this macro is run to be 1 more than the current lastRowSrc
    
End Sub

Like I said, when I run it, it hangs indefinitely however, when I click to close it and then tell Windows to restart the program, it says:
Run-time error '-2147417848 (80010108):
Method 'Copy' of object 'Range' failed.

When I click "Debug", it highlights the following line.:
Code:
wsDest1.Range(wsDest1.Cells(1, columnOfSAndP + 1), wsDest1.Cells(1, lastColumnDest)).Copy wsDest1.Range(wsDest1.Cells(1, columnOfSAndP + 2), wsDest1.Cells(1, lastColumnDest + 1)) 'shift all columns from beyond columnOfSAndP by 1 column and place the name of the person from wsSrc.Cells(currentRowSrc, 11) into wsDest1.Cells(currentRowDest, columnOfSAndP+1)


Is there something wrong at all or does VBA take really long to work on three to four thousand cells and the error just arises because I cancelled the operation?


Running the macro should interpret data from the larger excel file/workbook and then transfer that interpretation to the smaller Excel file/workbook. The smaller file should eventually become larger than the currently larger file but I'll call "This workbook" or "the smaller file" since I'm referring to their state before the macro's first fully successful run.

What I mean by "interpretation", if it's not clear, is that although in some cases, data can be simply copied and pasted, in other cases, the destination data might be different (but based off of) the source data. For example, "this workbook" should look at the larger file and find out the hours someone is working (where the name of the person or another name but let's always consider it to be the name of the person) and put a W at every intersection of the time worked and the name of the person working. If the person doesn't work at a certain time/date, nothing will be put. Any letter other than W is to be put manually (without the use of the macro).


"This workbook" should be empty before the macro is run as of row 2 and below as well as have no names to the right of S&P, Loto Quebec, and Project.

For now, there is nothing to do in "this workbook" for "Resources required".

Date and Day should be copy/pasted. For every one row in the larger file, there needs to be 36 columns in the smaller file (from 6:00 AM to midnight).

The times are to be interpreted as the union (in math terminology) of "Reg Start" (column L in larger file) and "Reg End" (column M in larger file) as well as "Inst Start" (Column T in larger file) and "Inst End" (Column U in larger file).


Plan, Work, Flag, Sick, Vac, Training each don't need to be dealth with using the macro (since they use excel formulas or whatever the terminology is - the point is they change dynamically too and without a macro's help).

Everything on the right of "Project" is to be added there manually (without the help of the macro).

If skill is "LQ" in the larger file, the name of the person should go to the right of "Loto Quebec" in "this workbook". If it's anything else including S&P in the larger file, it should go in S&P in "this workbook".

Also, I would like for the process every time the macro is run to continue from the column after the last one processed in the larger file rather than going through the thousands of columns again (unnecessarily) and freezing the window (as well as taking long).

If more information is needed, just ask.

Any help would be greatly appreciated!

P.S.
Is there any way I can give you guys sample workbooks so you can follow what's going on (since it seems that I cannot post an attachment here)?
 
Last edited:

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Forum statistics

Threads
1,213,560
Messages
6,114,304
Members
448,564
Latest member
ED38

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