0

enter image description hereI am trying to create code (Loop) so that when a task is allocated to a team member (in a cell in column H) the code searches the cell value with the existing sheet names and if there is a match, the sheet then makes the task member sheet active sheet, finds the last available line and adds the allocated tasks to the sheet. The code should run for all filled cells in the column.

However, the code i have currently written bugs out. I am finding it hard to define the worksheetname (Cell value) etc.

Sub TaskAllocation()

Dim cell As Range, Lastrow1 As Double, i As Integer
Dim SubTaskWs As Worksheet, Ws As Worksheet, Lastrow2 As Double
Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")
Set Ws = ActiveWorkbook.Sheets(WsName)

i = o

Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row
Lastrow2 = Ws.Range("A" & Rows.Count).End(xlUp).Row

For Each cell In SubTaskWs.Range("H4:H" & Lastrow1)
    For Each Ws In Sheets
        If cell.value = Ws.Name Then
            Ws.Range("A" + (Lastrow2 + (i))).EntireRow.Insert
            Call copyFormattingAbove(Ws, "A" & Lastrow2)
            Ws.Range(("A" & Lastrow2) + (i)).value = cell.Offset(, -6)
            Ws.Range(("B" & Lastrow2) + (i)).value = cell.Offset(, -5)

            i = i + 1
        End If
    Next Ws
Next cell

End Sub
  • You are trying to set `Ws` with `WsName` but as for your current code, `WsName` is empty. You need to delete that line and calculate `LastRow2` inside the `If` because there you already have the `Ws` set. – Damian Oct 03 '19 at 08:41
  • I have done as you said, but now there is a mismatch error on the " Ws.Range("A" + (Lastrow2 + (i))).EntireRow.Insert" line – Lawrence Forster Oct 03 '19 at 08:46

1 Answers1

0

I did change a bit your code to make it more readable.

Some tips for the future:

  1. Use the Option Explicit on the top of your moduel to fource the declaration of all your variables.
  2. Always try to declare your variables close to where they are used.
  3. Never declare a integervariable, use Long instead. Don't use Double for rows either, Double and Single are for floating numbers.

Here is the code:

Option Explicit
Sub TaskAllocation()

    Dim cell As Range
    Dim SubTaskWs As Worksheet
    Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")

    Dim Lastrow1 As Long
    Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row

    Dim ws As Worksheet
    Dim cell As Range
    Dim Lastrow2 As Long, i As Long
    i = 0

    Dim Tasks As Object

    FillTasks Tasks

    For Each cell In SubTaskWs.Range("H4:H" & Lastrow1) 'change this range and loop through the column with the tasks
        If Tasks.Exists(cell) Then GoTo AlreadyDone
        For Each ws In Sheets
            If SubTaskWs.Cells(cell.Row, "H") = ws.Name Then
                Lastrow2 = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
                copyFormattingAbove ws, "A" & Lastrow2
                ws.Range("A" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 2)
                ws.Range("B" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 3)
            End If
        Next ws
AlreadyDone:
    Next cell

End Sub
Function FillTasks(Tasks As Object)

    Set Tasks = CreateObject("Scripting.Dictionary")

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop through sheets
        If Not ws.Name = "Sub tasks" Then
            'code to find the right columnd and loop through the existing tasks
            'there is no need for an item on this case, you only need to know if it exists
            If Not Tasks.Exists(cell) Then Tasks.Add cell, 1
        End If
    Next ws

End Function
Damian
  • 5,152
  • 1
  • 10
  • 21
  • Still a mismatch error on the Ws.Range("A" + (Lastrow2 + (i))).EntireRow.Insert – Lawrence Forster Oct 03 '19 at 08:48
  • Also what does option explicit do – Lawrence Forster Oct 03 '19 at 08:49
  • Forces you to declare all the variables. On the other hand, why do you need to insert a row? it is already the last one right? If so, instead inserting, add a + 1 when you find the `Lastrow2` so it goes one row down. @LawrenceForster I've just edited my code, see if it works for you now. – Damian Oct 03 '19 at 08:50
  • I wanted to make sure that there was aways enough rows as the file may become large. Still produce an error when removing the insert row, however on the next lines "Ws.Range(("A" & Lastrow2) + (i)).value = cell.Offset(, -6)" so im assuming theres an erro in the Ws.Range – Lawrence Forster Oct 03 '19 at 08:53
  • Well from your code I can't know for sure, but if you start on row 4 (`H4`) and you try to go up 5 or 6 rows, it will throw an error. What are you trying to copy? If you could upload a screen from the main sheet and the worker sheet I could write it better. – Damian Oct 03 '19 at 08:55
  • Uploaded screenshot of the two sheets, had to crop and place next to each other as could only seem to upload one photo – Lawrence Forster Oct 03 '19 at 09:03
  • @LawrenceForster edited again, though if it gives error... Check if `Lastrow2` has a value. – Damian Oct 03 '19 at 09:06
  • Runs well, thank you so much! one quick question, is there a way to stop excel from going into not responding when the code is running or is it as theres a large amount of data to evaluate – Lawrence Forster Oct 03 '19 at 09:09
  • There is no way to stop that, you could for efficiency use arrays to work faster but while the code is running you can't use or interact with Excel. If the execution time gets prolonged you can while holding `Shift` right click on the Excel icon from your tool bar (the windows bar) and press Excel again, without leaving the `Shift` it will ask you to open a new instance so you can do something else meanwhile. Don't forget to mark the answer as correct if it helped :) – Damian Oct 03 '19 at 09:12
  • Cheers thank you so much. Its okay as im going to add a line in to not but task in if it already exists so that should make it faster as it will be only adding new tasks – Lawrence Forster Oct 03 '19 at 09:14
  • Sorry again, quick question. would this work to check if task is already in sheet? " " If cell = Ws.Range("A" & Lastrow2).value Then Else Ws.Range("A" & Lastrow2).value = SubTaskWs.Cells(cell.Row, 2) Ws.Range("B" & Lastrow2).value = SubTaskWs.Cells(cell.Row, 3) – Lawrence Forster Oct 03 '19 at 09:37
  • You'd need to have a dictionary, loop through all the worker sheets and store the existing tasks. Then when looping through the cells of the main sheet, if the cell exists on the dictionary, skip it. – Damian Oct 03 '19 at 09:40
  • Ahhh okay, that sounds complicated. Would it require a lot of code? – Lawrence Forster Oct 03 '19 at 09:42
  • @LawrenceForster you already know how to loop through sheets so you only need the dictionary part. [here](https://stackoverflow.com/a/58132940/7558682) you have an example of an answer I gave using dictionaries. And [here](http://www.snb-vba.eu/VBA_Dictionary_en.html) the guide from which I learned about using dictionaries. – Damian Oct 03 '19 at 09:44
  • I have read those articles and sort of understand it, hwoever looking at the example how would then get the code to go into the dictionary and input the correct value. – Lawrence Forster Oct 03 '19 at 10:08
  • @LawrenceForster I've edited my answer, gave you the lead to finish my code to suit your needs. – Damian Oct 03 '19 at 10:24
  • Hi @Damian, I am still trying to work out how to use a dictionary for the code above. I dont undertsand where it says "If Not ws.Name = "Sub tasks" Then" Isn tthis saying, if the worksheet name isnt = to sub tasks then? where as i would like it to be – Lawrence Forster Oct 10 '19 at 10:26