Challenging Macro help

[Natalia]

Hi, i have a work task which is very manual, i was hoping it could be automated.

I need a macro that will look at Col C in sheet "Raw" and look for single string codes before the first "-" if code found then create a tab for that code and import all data for that code to its own worksheet. If no code found then create a worksheet named "INVESTIGATION" and dump all unidentified items to that worksheet.

Note the single code will always be in Upper case, so its easy for the code to scan. Also once the data has imported to its own worksheet, i need the code to insert a row between each unique Comment, but not for sheet "INVESTIGATION". Please see below example.

This is a monthly task, so if new codes are found then the macro needs to create new worksheet for that code.

Excel Workbook
	A	B	C
5	Message	Feed	Description
6	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
8	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
9	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
10	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
11	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
12	Deleted	WTINCADISTAMPB	DMP1-Email Me
13	Deleted	WCTFUNFEAEXP	DMP1-Email You
14	Deleted	WCTFUNPEAEXP	DMP1-Email You
15	Deleted	WCTFUNPECEXP	DMP1-Email You
16	Deleted	WCTFUNPEZEXP	DMP1-Email You
17	Deleted	WEMFUNFE3EXP	CITI-Email Me
18	Deleted	WEMFUNFEAEXP	CITI-Email You
19	Deleted	WEMFUNFEBEXP	CITI-Email You
Raw

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	WTINCADISTAMPB	DMP1-Email Me
3
4	Deleted	WCTFUNFEAEXP	DMP1-Email You
5	Deleted	WCTFUNPEAEXP	DMP1-Email You
6	Deleted	WCTFUNPECEXP	DMP1-Email You
7	Deleted	WCTFUNPEZEXP	DMP1-Email You
DMP1

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	WEMFUNFE3EXP	CITI-Email Me
3
4	Deleted	WEMFUNFEAEXP	CITI-Email You
5	Deleted	WEMFUNFEBEXP	CITI-Email You
6
CITI

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
3	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
4	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
5	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
6	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
INVESTIGATION

 

[hiker95]

Natalia,

Here you go. I missed "insert a row between each unique Comment".


Sample raw data in worksheet Raw (grouped per your screenshot):

Excel Workbook
	A	B	C
5	Message	Feed	Description
6	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
8	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
9	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
10	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
11	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
12	Deleted	WTINCADISTAMPB	DMP1-Email Me
13	Deleted	WCTFUNFEAEXP	DMP1-Email You
14	Deleted	WCTFUNPEAEXP	DMP1-Email You
15	Deleted	WCTFUNPECEXP	DMP1-Email You
16	Deleted	WCTFUNPEZEXP	DMP1-Email You
17	Deleted	WEMFUNFE3EXP	CITI-Email Me
18	Deleted	WEMFUNFEAEXP	CITI-Email You
19	Deleted	WEMFUNFEBEXP	CITI-Email You
20
Raw

After the macro in their respective worksheets:

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
3	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
4	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
5	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
6	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
8
INVESTIGATION

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	WTINCADISTAMPB	DMP1-Email Me
3
4	Deleted	WCTFUNFEAEXP	DMP1-Email You
5	Deleted	WCTFUNPEAEXP	DMP1-Email You
6	Deleted	WCTFUNPECEXP	DMP1-Email You
7	Deleted	WCTFUNPEZEXP	DMP1-Email You
8
DMP1

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	WEMFUNFE3EXP	CITI-Email Me
3
4	Deleted	WEMFUNFEAEXP	CITI-Email You
5	Deleted	WEMFUNFEBEXP	CITI-Email You
6
CITI

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub NataliaV2()
' hiker95, 04/22/2011
' http://www.mrexcel.com/forum/showthread.php?t=545411
Dim wR As Worksheet, wI As Worksheet, ws As Worksheet
Dim c As Range, NR As Long
Dim Sp, H As String, a As Long, b As Long, LR As Long
Application.ScreenUpdating = False
Set wR = Worksheets("Raw")
For Each c In wR.Range("C6", wR.Range("C" & Rows.Count).End(xlUp))
  Sp = Split(c, "-")
  H = Trim(Sp(0))
  If InStr(H, " ") > 0 Then
    If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
      Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
      Set wI = Worksheets("INVESTIGATION")
      wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    Else
      Set wI = Worksheets("INVESTIGATION")
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    End If
  Else
    b = 0
    For a = 1 To Len(H) Step 1
      If IsNumeric(Mid(H, a, 1)) = True Then
        'do nothing
      ElseIf Asc(Mid(H, a, 1)) >= 97 And Asc(Mid(H, a, 1)) <= 122 Then
        b = b + 1
      End If
    Next a
    If b = 0 Then
      If Not Evaluate("ISREF(" & H & "!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = H
        Set ws = Worksheets(H)
        ws.Range("A1:C1") = [{"Message","Feed","Description"}]
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      Else
        Set ws = Worksheets(H)
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      End If
    Else
      If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
        Set wI = Worksheets("INVESTIGATION")
        wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      Else
        Set wI = Worksheets("INVESTIGATION")
        NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        wI.UsedRange.Columns.AutoFit
      End If
    End If
  End If
Next c
Set ws = Nothing
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Raw" And ws.Name <> "INVESTIGATION" Then
    LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For a = LR To 3 Step -1
      If ws.Cells(a, 3).Value <> ws.Cells(a - 1, 3).Value Then
        ws.Rows(a).Insert
      End If
    Next a
  End If
Next ws
wR.Activate
Application.ScreenUpdating = True
End Sub

Then run the NataliaV2 macro.

 

[Natalia]

Hiker when i run the macro multiple times, i noticed the code keeps adding the same data to the existing sheets which was created by the macro. So would it be better for the code to delete the sheets and re-create again?

 

[hiker95]

Natalia,

Hiker when i run the macro multiple times, i noticed the code keeps adding the same data to the existing sheets which was created by the macro. So would it be better for the code to delete the sheets and re-create again?

Each time you run the macro, you want all the worksheets, if they exist (except Raw) to be deleted first?

 

[Natalia]

Natalia,



Each time you run the macro, you want all the worksheets, if they exist (except Raw) to be deleted first?

Yes that would be the best option. I will be adding extra worksheets which will not be deleted so like "Task" Errors"

 

[hiker95]

Natalia,


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub NataliaV3()
' hiker95, 04/23/2011
' http://www.mrexcel.com/forum/showthread.php?t=545411
Dim wR As Worksheet, wI As Worksheet, ws As Worksheet
Dim c As Range, Sp, H As String
Dim NR As Long, a As Long, b As Long, LR As Long
Application.ScreenUpdating = False
Set wR = Worksheets("Raw")
If Worksheets.Count > 1 Then
  Application.DisplayAlerts = False
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Raw" And ws.Name <> "Task" And ws.Name <> "Errors" Then ws.Delete
  Next ws
  Application.DisplayAlerts = True
End If
For Each c In wR.Range("C6", wR.Range("C" & Rows.Count).End(xlUp))
  Sp = Split(c, "-")
  H = Trim(Sp(0))
  If InStr(H, " ") > 0 Then
    If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
      Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
      Set wI = Worksheets("INVESTIGATION")
      wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    Else
      Set wI = Worksheets("INVESTIGATION")
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    End If
  Else
    b = 0
    For a = 1 To Len(H) Step 1
      If IsNumeric(Mid(H, a, 1)) = True Then
        'do nothing
      ElseIf Asc(Mid(H, a, 1)) >= 97 And Asc(Mid(H, a, 1)) <= 122 Then
        b = b + 1
      End If
    Next a
    If b = 0 Then
      If Not Evaluate("ISREF(" & H & "!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = H
        Set ws = Worksheets(H)
        ws.Range("A1:C1") = [{"Message","Feed","Description"}]
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      Else
        Set ws = Worksheets(H)
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      End If
    Else
      If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
        Set wI = Worksheets("INVESTIGATION")
        wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      Else
        Set wI = Worksheets("INVESTIGATION")
        NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        wI.UsedRange.Columns.AutoFit
      End If
    End If
  End If
Next c
Set ws = Nothing
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Raw" And ws.Name <> "INVESTIGATION" Then
    LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For a = LR To 3 Step -1
      If ws.Cells(a, 3).Value <> ws.Cells(a - 1, 3).Value Then
        ws.Rows(a).Insert
      End If
    Next a
  End If
Next ws
wR.Activate
Application.ScreenUpdating = True
End Sub

Then run the NataliaV3 macro.

 

[Natalia]

Hiker this is great. One more thing, not sure how difficult this is but would it be possible to reflect stats for each team in sheet "Tasks" so i know that it ties back to the raw data and nothing has been missed, i'm just being cautious, something like below

Excel Workbook
	A	B	C
5	Team	Raw	Actual
6	AMP1	331	331
7	Etc
8	Etc
9	Etc
10	Etc
11	Etc
12	Etc
13	Etc
14	Etc
15	Etc
16	Etc
17	Etc
18	Etc
19	Etc
20	Etc
21	Etc
22	Etc
23	Etc
24	Total	???	???
Tasks

 

[hiker95]

Natalia,

One more thing, not sure how difficult this is but would it be possible to reflect stats for each team in sheet "Tasks" so i know that it ties back to the raw data and nothing has been missed, i'm just being cautious, something like below

I think I know where you are going with this last, and final request.


I will need a workbook, with worksheet Raw containing raw data. And, worksheet Tasks manually completed by you, per your last, and final request.

You can upload your workbook to www.box.net and provide us with a link to your workbook.

 

[Natalia]

Hiker, wouldn't the below sample data be sufficient as the data will be changing everymonth, so i assumed if it works on sample data then it should work for all data?

Excel Workbook
	A	B	C
5	Team	Raw	Actual
6	DMP1	5	5
7	CITI	3	3
8	INVESTIGATIONS	6	6
9
10
Tasks

Excel Workbook
	A	B	C
5	Message	Feed	Description
6	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
8	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
9	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
10	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
11	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
12	Deleted	WTINCADISTAMPB	DMP1-Email Me
13	Deleted	WCTFUNFEAEXP	DMP1-Email You
14	Deleted	WCTFUNPEAEXP	DMP1-Email You
15	Deleted	WCTFUNPECEXP	DMP1-Email You
16	Deleted	WCTFUNPEZEXP	DMP1-Email You
17	Deleted	WEMFUNFE3EXP	CITI-Email Me
18	Deleted	WEMFUNFEAEXP	CITI-Email You
19	Deleted	WEMFUNFEBEXP	CITI-Email You
20
Raw

 

[hiker95]

Natalia,

In order for the formulae to work correctly on worksheet Tasks, worksheet INVESTIGATION will have to be created all the time.


Sample raw data in worksheet Raw:

Excel Workbook
	A	B	C
5	Message	Feed	Description
6	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
8	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
9	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
10	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
11	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
12	Deleted	WTINCADISTAMPB	DMP1-Email Me
13	Deleted	WCTFUNFEAEXP	DMP1-Email You
14	Deleted	WCTFUNPEAEXP	DMP1-Email You
15	Deleted	WCTFUNPECEXP	DMP1-Email You
16	Deleted	WCTFUNPEZEXP	DMP1-Email You
17	Deleted	WEMFUNFE3EXP	CITI-Email Me
18	Deleted	WEMFUNFEAEXP	CITI-Email You
19	Deleted	WEMFUNFEBEXP	CITI-Email You
20
Raw

After the macro:

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	1ANXXEAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
3	Deleted	1GCSXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
4	Deleted	1GSXXSAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
5	Deleted	1OGSXOAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
6	Deleted	WSTBFAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
7	Deleted	WTINCAAUDREP	150311 Joe Bloggs - there is a separate holdings in these bank accounts
8
INVESTIGATION

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	WTINCADISTAMPB	DMP1-Email Me
3
4	Deleted	WCTFUNFEAEXP	DMP1-Email You
5	Deleted	WCTFUNPEAEXP	DMP1-Email You
6	Deleted	WCTFUNPECEXP	DMP1-Email You
7	Deleted	WCTFUNPEZEXP	DMP1-Email You
8
DMP1

Excel Workbook
	A	B	C
1	Message	Feed	Description
2	Deleted	WEMFUNFE3EXP	CITI-Email Me
3
4	Deleted	WEMFUNFEAEXP	CITI-Email You
5	Deleted	WEMFUNFEBEXP	CITI-Email You
6
CITI

Excel Workbook
	A	B	C
5	Team	Raw	Actual
6	DMP1	5	5
7	CITI	3	3
8	INVESTIGATION	6	6
9
Tasks

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub NataliaV4()
' hiker95, 04/24/2011
' http://www.mrexcel.com/forum/showthread.php?t=545411
Dim wR As Worksheet, wI As Worksheet, ws As Worksheet, wT As Worksheet
Dim c As Range, Sp, H As String
Dim NR As Long, a As Long, b As Long, LR As Long, LR2 As Long
Application.ScreenUpdating = False
Set wR = Worksheets("Raw")
If Worksheets.Count > 1 Then
  Application.DisplayAlerts = False
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Raw" And ws.Name <> "Tasks" And ws.Name <> "Errors" Then ws.Delete
  Next ws
  Application.DisplayAlerts = True
End If
For Each c In wR.Range("C6", wR.Range("C" & Rows.Count).End(xlUp))
  Sp = Split(c, "-")
  H = Trim(Sp(0))
  If InStr(H, " ") > 0 Then
    If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
      Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
      Set wI = Worksheets("INVESTIGATION")
      wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    Else
      Set wI = Worksheets("INVESTIGATION")
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    End If
  Else
    b = 0
    For a = 1 To Len(H) Step 1
      If IsNumeric(Mid(H, a, 1)) = True Then
        'do nothing
      ElseIf Asc(Mid(H, a, 1)) >= 97 And Asc(Mid(H, a, 1)) <= 122 Then
        b = b + 1
      End If
    Next a
    If b = 0 Then
      If Not Evaluate("ISREF(" & H & "!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = H
        Set ws = Worksheets(H)
        ws.Range("A1:C1") = [{"Message","Feed","Description"}]
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      Else
        Set ws = Worksheets(H)
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      End If
    Else
      If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
        Set wI = Worksheets("INVESTIGATION")
        wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      Else
        Set wI = Worksheets("INVESTIGATION")
        NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        wI.UsedRange.Columns.AutoFit
      End If
    End If
  End If
Next c
Set ws = Nothing
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Raw" And ws.Name <> "INVESTIGATION" Then
    LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For a = LR To 3 Step -1
      If ws.Cells(a, 3).Value <> ws.Cells(a - 1, 3).Value Then
        ws.Rows(a).Insert
      End If
    Next a
  End If
Next ws
If Not Evaluate("ISREF(Tasks!A1)") Then
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tasks"
End If
Set wT = Worksheets("Tasks")
If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
  Set wI = Worksheets("INVESTIGATION")
  wI.Range("A1:C1") = [{"Message","Feed","Description"}]
  wI.UsedRange.Columns.AutoFit
End If
LR = wT.Cells(Rows.Count, 1).End(xlUp).Row
If LR > 5 Then wT.Range("A6:C" & LR).ClearContents
wT.Range("A5:C5") = [{"Team","Raw","Actual"}]
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Raw" And ws.Name <> "Tasks" And ws.Name <> "INVESTIGATION" Then
    NR = wT.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    wT.Range("A" & NR) = ws.Name
  End If
Next ws
wT.Range("A" & NR + 1) = "INVESTIGATION"
LR = wT.Cells(Rows.Count, 1).End(xlUp).Row
For a = 6 To LR Step 1
  wT.Range("C" & a).Formula = "=CountA(" & wT.Range("A" & a).Value & "!A:A)-1"
Next a
For a = 6 To LR - 1 Step 1
  wT.Range("B" & a).FormulaR1C1 = "=COUNTIF(Raw!C[1],RC[-1]&""*"")"
Next a
LR2 = wR.Cells(Rows.Count, 1).End(xlUp).Row
wT.Range("B" & LR).Formula = "=CountA(Raw!A6:A" & LR2 & ")-Sum(B6:B" & LR - 1 & ")"
wT.UsedRange.Columns.AutoFit
wT.Activate
Application.ScreenUpdating = True
End Sub

Then run the NataliaV4 macro.

 

[hiker95]

Natalia,


One last change and we are finished.


After the macro on worksheet Tasks:

Excel Workbook
	A	B	C
5	Team	Raw	Actual
6	DMP1	5	5
7	CITI	3	3
8	INVESTIGATION	6	6
9	Total	14	14
10
Tasks

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub NataliaV5()
' hiker95, 04/24/2011
' http://www.mrexcel.com/forum/showthread.php?t=545411
Dim wR As Worksheet, wI As Worksheet, ws As Worksheet, wT As Worksheet
Dim c As Range, Sp, H As String
Dim NR As Long, a As Long, b As Long, LR As Long, LR2 As Long
Application.ScreenUpdating = False
Set wR = Worksheets("Raw")
If Worksheets.Count > 1 Then
  Application.DisplayAlerts = False
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Raw" And ws.Name <> "Tasks" And ws.Name <> "Errors" Then ws.Delete
  Next ws
  Application.DisplayAlerts = True
End If
For Each c In wR.Range("C6", wR.Range("C" & Rows.Count).End(xlUp))
  Sp = Split(c, "-")
  H = Trim(Sp(0))
  If InStr(H, " ") > 0 Then
    If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
      Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
      Set wI = Worksheets("INVESTIGATION")
      wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    Else
      Set wI = Worksheets("INVESTIGATION")
      NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
      wI.UsedRange.Columns.AutoFit
    End If
  Else
    b = 0
    For a = 1 To Len(H) Step 1
      If IsNumeric(Mid(H, a, 1)) = True Then
        'do nothing
      ElseIf Asc(Mid(H, a, 1)) >= 97 And Asc(Mid(H, a, 1)) <= 122 Then
        b = b + 1
      End If
    Next a
    If b = 0 Then
      If Not Evaluate("ISREF(" & H & "!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = H
        Set ws = Worksheets(H)
        ws.Range("A1:C1") = [{"Message","Feed","Description"}]
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      Else
        Set ws = Worksheets(H)
        NR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        ws.UsedRange.Columns.AutoFit
      End If
    Else
      If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
        Set wI = Worksheets("INVESTIGATION")
        wI.Range("A1:C1") = [{"Message","Feed","Description"}]
      Else
        Set wI = Worksheets("INVESTIGATION")
        NR = wI.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        wI.Range("A" & NR).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
        wI.UsedRange.Columns.AutoFit
      End If
    End If
  End If
Next c
Set ws = Nothing
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Raw" And ws.Name <> "INVESTIGATION" Then
    LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For a = LR To 3 Step -1
      If ws.Cells(a, 3).Value <> ws.Cells(a - 1, 3).Value Then
        ws.Rows(a).Insert
      End If
    Next a
  End If
Next ws
If Not Evaluate("ISREF(Tasks!A1)") Then
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tasks"
End If
Set wT = Worksheets("Tasks")
If Not Evaluate("ISREF(INVESTIGATION!A1)") Then
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "INVESTIGATION"
  Set wI = Worksheets("INVESTIGATION")
  wI.Range("A1:C1") = [{"Message","Feed","Description"}]
  wI.UsedRange.Columns.AutoFit
End If
LR = wT.Cells(Rows.Count, 1).End(xlUp).Row
If LR > 5 Then wT.Range("A6:C" & LR).ClearContents
wT.Range("A5:C5") = [{"Team","Raw","Actual"}]
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Raw" And ws.Name <> "Tasks" And ws.Name <> "INVESTIGATION" Then
    NR = wT.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    wT.Range("A" & NR) = ws.Name
  End If
Next ws
wT.Range("A" & NR + 1) = "INVESTIGATION"
LR = wT.Cells(Rows.Count, 1).End(xlUp).Row
For a = 6 To LR Step 1
  wT.Range("C" & a).Formula = "=CountA(" & wT.Range("A" & a).Value & "!C)-1"
Next a
For a = 6 To LR - 1 Step 1
  wT.Range("B" & a).FormulaR1C1 = "=COUNTIF(Raw!C[1],RC[-1]&""*"")"
Next a
LR2 = wR.Cells(Rows.Count, 3).End(xlUp).Row
wT.Range("B" & LR).Formula = "=CountA(Raw!C6:C" & LR2 & ")-Sum(B6:B" & LR - 1 & ")"
LR = wT.Cells(Rows.Count, 1).End(xlUp).Row
wT.Range("A" & LR + 1) = "Total"
wT.Range("B" & LR + 1).Formula = "=Sum(B6:B" & LR & ")"
wT.Range("C" & LR + 1).Formula = "=Sum(C6:C" & LR & ")"
wT.Range("A" & LR + 1 & ":C" & LR + 1).Font.Bold = True
wT.UsedRange.Columns.AutoFit
wT.Activate
Application.ScreenUpdating = True
End Sub

Then run the NataliaV5 macro.