2 
Sub Exercise()              ' ' to read data from file tasks.xls and 
    Dim Arr As Variant, Arr1 As Variant  ' feed the task name for the person
    Dim iRow As Integer                  ' in a month in this file
    Dim iCol As Integer
    Dim i As Integer, x As Integer
    Dim name As String

    'name = Cells(1, 1).Value
    Arr = Workbooks.Open("E:tasks.xlsx").Sheets("Sheet1").Range("B1:E1").Value
    Arr1 = Workbooks.Open("E:tasks.xlsx").Sheets("Sheet1").Range("B2:E2").Value
    Sheets(1).Cells(1, 1).Select                  ' go to beginning cell

     For i = 1 To Arr1(1, 1)
        Cells(6, 4 + i).Value = Arr(1, 1)
        a = i + 4
    Next i


    For i = 1 To Arr1(1, 2)
        Cells(6, a + i).Value = Arr(1, 2)
        b = a + i
    Next i

    For i = 1 To Arr1(1, 3)
        Cells(6, b + i).Value = Arr(1, 3)
        C = b + i
    Next i

    For i = 1 To Arr1(1, 4)
        Cells(6, C + i).Value = Arr(1, 4)
        d = a + i
    Next i                                               

    Do While ActiveCell.Row <> Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
                                                 ' some times i get infinte loop
    ActiveCell.Offset(2, 0).Select              ' span till the last
    name = ActiveCell.Value                      '  non empty  row
    Arr = Sheets(1).Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 5)).Value
    Arr1 = Sheets(1).Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(1, 5)).Value


    With ThisWorkbook.Sheets(3)            'algorithm to search the name                                                                                         '                                               positon in this excel file
    Dim findrow As Range
    Set findrow = .Range("A:A").Find(What:=name, LookIn:=xlValues)
   iRow = findrow.Row                   ' required row where name is found

    For i = 1 To Arr1(1, 1)
        Cells(iRow, 4 + i).Value = Arr(1, 1)
       a = i + 4
    Next i

    For i = 1 To Arr1(1, 2)
        Cells(iRow, a + i).Value = Arr(1, 2)
        b = a + i
    Next i

    For i = 1 To Arr1(1, 3)
        Cells(iRow, b + i).Value = Arr(1, 3)
        C = b + i
    Next i

    For i = 1 To Arr1(1, 4)
        Cells(iRow, C + i).Value = Arr(1, 4)
        d = a + i
    Next i

    Loop

End Sub

I was asked to design the work allotment process for the company. Work is allotted in the given manner: If suppose a task T1 is allotted to a person for 5 days, it should be displayed against his name for 5 consecutive days in the work allotment file. I have written a Visual basic code in MS Excel using macros. I am able to allot the work to the correctly on the date but not to the correct person. . 

**Workallotment.xlsm** - **Output**
Anand-Web apps              1   2   3   4   5   6   7   8   9   10  11  12  
Praveen                     T1  T1  T1  T1  T2  T2  T2  T3  T4  T4                      
Bharath Vijay                                                                           
Kailash                                                                         
Sriram                                                                          
Walter                      c1  c2  c2  c3  c3  c3  c4  c4  c4  c4                      
Harshith                                                                            
Karthik                     P1  P1  P1  P1  P1  P1  P2  P2  P2  P3  P3  P4  
Arvind                                                                          
Anirudh-Mob apps                                                                            
Sharath                                                                         

**Tasks.xls**

Praveen     T1  T2  T3  T4
            4   3   1   2
Karthik     P1  P2  P3  P4
             6  3   2   1
Walter      c1  c2  c3  c4
            1   2   3   4

I m executing the macro from 3rd sheet -May from workallotment.xlsm and invoking tasks.xls from the macro in workallotment.xlsm.The final output is in workallotment.xlsm
Improve this question
6
  • I tried adding "end with" before loop and end sub. I m still getting the same error Commented May 17, 2016 at 7:26
  • In which line are you getting the error message? (Also, please note that the End With is absolutely necessary, but you probably have other errors in your code.) Commented May 17, 2016 at 8:49
  • I have no other errors.I tried commenting the "with" code and executing.It is displaying the tasks correctly but not against the names.But if I include the "with" code it gives a RUNTIME ERROR 91 : Object variable or with block variable not set Commented May 17, 2016 at 11:53
  • Forget the with block . I have replaced "with block" by another code below: [ Set findrow = Sheets(3).Range("A1:A100").find(What:=name, After:=Sheets(3).Range("A1"), LookIn:=xlFormulas) If Not findrow Is Nothing Then MsgBox ("not found") End If irow = findrow .Row ] Still I m getting the same runtime error " Object variable or with block variable not set" and I also replaced the last statement by"set irow = findrow .Row" , it shows object required-complier error Commented May 17, 2016 at 12:25
  • Can you please post an example (edit it into your question) of how your table in tasks.xlsk looks like, and how the results are supposed to look like? (Also, from where are you running this code? Another workbook? Is the final result table in "Sheet1" of tasks.xlsx?) Commented May 17, 2016 at 14:21

1 Answer 1

Reset to default
2

Put the line 

End With

before 

    Loop

End Sub

and your error message should disappear.

Edit: I have rewritten your code, and it now works for me. Note that you have to change some Sheetnames and filepaths to fit your workbooks. This code goes into the Workallotment Workbook (as a separate module):

Sub workallotment()

Dim workallotmentWB, tasksWB As Workbook
Dim waSheet As Worksheet

Dim wa_nameRng As Range

Dim wa_nameRow, wa_firstRow, wa_lastRow As Integer  'work allotment rows
Dim t_firstRow, t_lastrow As Integer                'task rows

Dim curTaskCol As Integer   'current task column
Dim wa_tmpcol As Integer    'work allotment, temp column


    Set workallotmentWB = ThisWorkbook
    Set tasksWB = Workbooks.Open("C:/users/q393996/Desktop/tasks.xlsx")

    'notes on data structure:
    '- tasks workbook:
        'first name starts in A1 of "Sheet1"
    '- workallotment workbook:
        'first name starts in A2 of Sheet named "workallotment"
        'tasks are to be written starting in B2
        'in Row 1 are headers (number of days)

    t_firstRow = 1
    wa_firstRow = 2
    wa_nameRow = 0

    Set waSheet = workallotmentWB.Worksheets("workallotment")

    With tasksWB.Worksheets("Sheet1")

        'finding the last rows
        t_lastrow = .Range("A1000000").End(xlUp).Row + 1
        wa_lastRow = waSheet.Range("A1000000").End(xlUp).Row

        'goes through all the names in tasks_Sheet1
        For r = t_firstRow To t_lastrow Step 2

            Set wa_nameRng = waSheet.Range("A:A").Find(.Range("A" & r).Value, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)

            If Not wa_nameRng Is Nothing Then

                wa_nameRow = wa_nameRng.Row

                curTaskCol = 2
                wa_tmpcol = 2

                Do While Not IsEmpty(.Cells(r, curTaskCol).Value)

                    For c = 1 To .Cells(r + 1, curTaskCol).Value
                        waSheet.Cells(wa_nameRow, wa_tmpcol).Value = .Cells(r, curTaskCol).Value
                        wa_tmpcol = wa_tmpcol + 1
                    Next c

                    curTaskCol = curTaskCol + 1

                Loop

            End If

        Next r

    End With

    MsgBox ("done")

End Sub

In general, you should always specify which workbook and worksheet you are working on in the code. Don't rely on ActiveWorkbook, ActiveCell, .Select etc, as these can produce too many mistakes, which you may not even realise. For one, it is difficult to understand the code, but more importantly, what happens if the user unwittingly selects another workbook? ActiveCell would be somewhere completely different than you intended.

Please also note the comments in the code. Feel free to ask if you have any questions! :)

Improve this answer
Sign up to request clarification or add additional context in comments.

13 Comments

I am getting an error in the above code in the line " Set waSheet = workallotmentWB.Worksheets("workallotment") " Runtime error 9: Subscript out of range
Yes, here you need to change "workallotment" to the actual name of your sheet, where you want the results. I just named it workallotment in my file
I m still getting the Runtime error 91 : Object variable or with block variable not set....I found that the error is in the line: ".find(.Range("A" & r).Value, " .Because I searched for individiual names I got no error .But on putting this code I got runtime error 91. Btw How is your input-tasks.xls . Can you send me the excel file you used ? because even if I put individual names I get tasks mixed up between two membeers in output but against the correct member.
In your tasks.xlsx file, is your Sheet called "Sheet1"? If not, you also need to change that in the line With tasksWB.Worksheets("Sheet1"). I built the tasks.xlsx just as you showed above in the table, with "Praveen" in A1, and "T1" in B1 etc. Also, if you haven't already, you need to change the filepath in Set tasksWB = Workbooks.Open("C:/users/Sun/Desktop/tasks.xlsx") to the path of your file.
Yes it is called "Sheet1" in tasks.xlsx in my file also. I changed the location also. I m getting some output and no errors if I give individual names in place of ".find(.Range("A" & r).Value, For example : .find("Praveen") in your code. But I get errors if I give the find command you gave..Is it because of any class/reference missing in Excel 2010 causing the error ? Or do you have to give "set" in some places of variable assignment?
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.