Making a loop to execute same code multiple times

Question

I need some help to create a loop from my code

The code has two main functions:

Copy and paste general data to another workbook
Copy and paste employee data to another workbook

I want to make a loop of my code (code is shown below). I can make this code 15 times and it will work but I think that a loop is better. I don't have any experience with loops.

So when I press a button on my sheet it copies the general data and opens a other workbook, then it goes back tot he main workbook and copies the employee data and paste them in the other workbook.

The workbook that needs to be opened is found in range F82:F96, so first F82 then F83... and so on, until it reaches F96 and then the code must stop.

The general data is always found in row 15 & 16.

The employee data is found with the same string as the workbook that must be opened. The row after the string must me copied and paste in the other workbook. So for example (G82:DI82).

What I have

I made a code that works for 1 employee in cell(F82) the code below opens the workbook of this employee then copies the general data then find the right column and row to paste. Then I paste the data then it goes back tot he main workbook and copies the data which belongs to he employee (G82:DI82) an paste this data in the other workbook. Then it saves closes the opened workbook. The main workbook stays open.

What I expect

I need a loop to repeat the code. So first the employee which is in (F82) then the employee which in (F83) and so on.

The code:

Private Sub mUpdate_Click()

Dim General As Range
Dim employe1hours As Range
Dim employepaste As Range
Dim employepastehours As Range
Dim CurrentweekColumn As Range
Dim Currentweekpaste As Range

Dim employepath As String
Dim employe1 As String
Dim rowstr As String
Dim Foundrow As Range
Dim Currentweek As String


employepath = "J:\Planning\Medewerkers\"
Currentweek = Range("B7").Value
employe1 = Range("F82").Value
rowstr = Range("A2").Value

    With ActiveWorkbook.Sheets("Planning").Range("14:14")
    Set CurrentweekColumn = .find(what:=Currentweek, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    End With
    
        Set General = ActiveWorkbook.Sheets("Planning").Range(Cells(15, CurrentweekColumn.Column), Cells(16, CurrentweekColumn.Offset(0, 106).Column))
        General.Copy
           
        Workbooks.Open (employepath & employe1 & ".xlsm")
        
            With ActiveWorkbook.Sheets("Blad1").Range("14:14")
            Set Currentweekpaste = .find(what:=Currentweek, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            End With
               
            With ActiveWorkbook.Sheets("Blad1").Range("A:A")
            Set Foundrow = .find(what:=rowstr, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            End With
            
            Set employepaste = ActiveWorkbook.Sheets("Blad1").Range(Cells(Foundrow.Row, Currentweekpaste.Column).Address)
            employepaste.PasteSpecial Paste:=xlPasteFormats
            employepaste.PasteSpecial Paste:=xlPasteValues
            
                Workbooks(rowstr & ".xlsm").Activate
                Set employe1hours = ActiveWorkbook.Sheets("Planning").Range(Cells(82, CurrentweekColumn.Column), Cells(82, CurrentweekColumn.Offset(0, 106).Column))
                employe1hours.Copy
                
                Workbooks(employe1 & ".xlsm").Activate
                Set employepastehours = ActiveWorkbook.Sheets("Blad1").Range(Cells(Foundrow.Offset(2, 0).Row, Currentweekpaste.Column).Address)
                employepastehours.PasteSpecial Paste:=xlPasteValues
                
                ActiveWorkbook.Save
                ActiveWorkbook.Close

Look at using a function rather than a sub you can then say fnUpdate(curweek as long, employee1 as string,rowstr as string) for example. You can then loop the range and say fnUpdate(range("a" & counter).value, range("b" & counter).value ........ — Nathan_Sav
– Nathan_Sav, Commented Jan 16, 2019 at 14:22
and where do i say what the loop must do (i don't have any experience with loops) @nicomp i don't have any loops yet because i dont know how they work sorry — Jelle van der Heijden
– Jelle van der Heijden, Commented Jan 16, 2019 at 14:34
@JellevanderHeijden The point of SO is that you make an attempt and we help. If you don 't know anything about loops, that's OK, but we expect you to study up a little then we will help you. I would observe that you posted some moderately complex code that, if you wrote it, indicates you have the skillz to figure out a little loop knowledge. — nicomp
– nicomp, Commented Jan 16, 2019 at 15:52

Pᴇʜ · Accepted Answer · 2019-01-16 15:21:54Z

Since we cannot do all the work for you, this should give you an idea how the loop could look like:

Option Explicit

Public Sub MyUpdateProcedure()
    Dim Employees As Range 'define the range of employees
    Set Employees = ThisWorkbook.Worksheets("SheetName").Range("F82:F96")

    Dim CurrentWorkbook As Workbook
    Const EmployePath As String = "J:\Planning\Medewerkers\"


    Dim Employe As Range
    For Each Employe In Employees 'loop throug all employees
        'open the workbook
        Set CurrentWorkbook = Workbooks.Open(EmployePath & Employe.Value & ".xlsm")

        With CurrentWorkbook.Sheets("Blad1")
            'your stuff here
        End With


        'your other stuff here

        'save and close workbook
        CurrentWorkbook.Close SaveChanges:=True
    Next Employe
End Sub

Note that you have to avoid ActiveWorkbook and instead set the opened workbook into a variable like Set CurrentWorkbook = Workbooks.Open that you can easily use then.

Also make sure that all your Range(…) objects have a workbook/worksheet specified like ThisWorkbook.Worksheets("SheetName").Range(…) otherwise Excel guesses which worksheet you mean.

Also be aware of errors:

Set CurrentWorkbook = Workbooks.Open(EmployePath & Employe.Value & ".xlsm")

will throw an error if the workbook does not exist so you might want to catch it:

    'open the workbook
    Set CurrentWorkbook = Nothing 'initialize since we are in a loop!
    On Error Resume Next 'next line throws an error if file not found so catch it
    Set CurrentWorkbook = Workbooks.Open(EmployePath & Employe.Value & ".xlsm")
    On Error GoTo 0 'always re-activate error reporting!

    If Not CurrentWorkbook Is Nothing Then
        'file for employee was found
        With CurrentWorkbook.Sheets("Blad1")
            'your stuff here
        End With


        'your other stuff here

        'save and close workbook
        CurrentWorkbook.Close SaveChanges:=True
    Else
        'file for employee was not found
    End If

Collectives™ on Stack Overflow

Making a loop to execute same code multiple times

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related