afniz
08-11-2013, 02:57 PM
Hello All,
I have spent many hours on YouTube trying to write a simple macro that would help me with my reports that I have to run and data-manipulate manually every month. I am afraid that this macro exceeds my current knowledge and, as suggested and highly recommended by one of my friends, I am totally dependent on ExcelForum specialists.
What I am looking for is a macro that would generate a separate worksheet and populate all names and tasks people perform. I have attached a spread sheet with my small database example just to give you an idea.
The main source (database) I receive every month is a simple spread sheet containing just several columns:
- Column A - Name of a person
- Column B - Team of that person
- Column C - Task 1 (with "1" if the tasks has been performed at least once or blank if it has not)
- Column D - Task 2 (with "1" if the tasks has been performed at least once or blank if it has not)
- Column E - Task 3 (with "1" if the tasks has been performed at least once or blank if it has not)
Of course some people are involved in more tasks then others and in some months some of them do not perform these identified tasks at all.
What I am looking for is a simple button that would copy all the names into a separate spread sheet that would look like "Result" that I created manually. For every person performing more than one tasks, the macro would populate the name twice, each with different task. If for any reason one of the names has no "1" for any of the tasks, which means none of the three identified tasks have been performed by that person, that person would be skipped. Every month the tasks will be the same but the number of people and tasks they perform may change significantly.
As an extra feature, there could be a radio button that would identify whether all departments or only one of them would be included in the generated tasks list.
If there is anybody who could help me with writing that macro I would be VERY grateful !
I am available any time for additional comments, further explanation and to answer any questions.
I am looking forward to hearing from you soon.
Thank you.
Doug Robbins
08-11-2013, 10:42 PM
The following code will do what you want for All Departments:
Sub MakeResult()
Dim i As Long, j As Long
j = 1
With Sheets("Result").Range("A1")
.Offset(0, 0) = "Name"
.Offset(0, 1) = "Team"
.Offset(0, 2) = "Task"
For i = 1 To Sheets("Source").Range("A1").CurrentRegion.Rows.Count - 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
If Sheets("Source").Range("A1").Offset(i, 2) = 1 Then
.Offset(j, 2) = "Task1"
If Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
j = j + 1
Next i
End With
End Sub
If you use ActiveX OptionButtons with the names OptAllDepartments, OptInternational and OptDomestic, then the following code will populate the Results sheet with the relevant records from the Source sheet for the OptionButton that is selected:
Sub MakeResult()
Dim i As Long, j As Long
Dim strTeam As String
If Sheets("Source").OptAllDepartments.Value = True Then
strTeam = "All"
ElseIf Sheets("Source").optInternational.Value = True Then
strTeam = "International"
Else
strTeam = "Domestic"
End If
j = 1
With Sheets("Result").Range("A1")
.Offset(0, 0) = "Name"
.Offset(0, 1) = "Team"
.Offset(0, 2) = "Task"
If strTeam = "All" Then
For i = 1 To Sheets("Source").Range("A1").CurrentRegion.Rows.Count - 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
If Sheets("Source").Range("A1").Offset(i, 2) = 1 Then
.Offset(j, 2) = "Task1"
If Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = Sheets("Source").Range("A1").Offset(i, 1)
.Offset(j, 2) = "Task3"
End If
j = j + 1
Next i
ElseIf strTeam = "International" Then
For i = 1 To Sheets("Source").Range("A1").CurrentRegion.Rows.Count - 1
If Sheets("Source").Range("A1").Offset(i, 1) = "International" Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
If Sheets("Source").Range("A1").Offset(i, 2) = 1 Then
.Offset(j, 2) = "Task1"
If Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
.Offset(j, 2) = "Task3"
End If
j = j + 1
End If
Next i
Else
For i = 1 To Sheets("Source").Range("A1").CurrentRegion.Rows.Count - 1
If Sheets("Source").Range("A1").Offset(i, 1) = "Domestic" Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "International"
If Sheets("Source").Range("A1").Offset(i, 2) = 1 Then
.Offset(j, 2) = "Task1"
If Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "Domestic"
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "Domestic"
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "Domestic"
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 3) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "Domestic"
.Offset(j, 2) = "Task2"
If Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
j = j + 1
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "Domestic"
.Offset(j, 2) = "Task3"
End If
ElseIf Sheets("Source").Range("A1").Offset(i, 4) = 1 Then
.Offset(j, 0) = Sheets("Source").Range("A1").Offset(i, 0)
.Offset(j, 1) = "Domestic"
.Offset(j, 2) = "Task3"
End If
j = j + 1
End If
Next i
End If
End With
End Sub
This might suffice:
Sub M_snb()
sn = Sheets("source").Cells(1).CurrentRegion
ReDim sp((UBound(sn) - 1) * (UBound(sn, 2) - 2), 2)
For j = 0 To UBound(sp) - 1
If sn(2 + j \ (UBound(sp, 2) + 1), 3 + j Mod (UBound(sp, 2) + 1)) <> "" Then
For jj = 0 To UBound(sp, 2)
sp(j, jj) = sn(IIf(jj = UBound(sp, 2), 1, 2 + j \ (UBound(sp, 2) + 1)), IIf(jj = UBound(sp, 2), 3 + j Mod (UBound(sp, 2) + 1), 1 + jj Mod (UBound(sp, 2))))
Next
End If
Next
Sheets("result").Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
Sheets("result").Columns(1).SpecialCells(4).EntireRow.Delete
End Sub
Doug Robbins
08-13-2013, 11:44 PM
The following macros will handle any number of tasks, the first one for all teams and the second for the team for which the ActiveX Option button is selected:
Sub MakeResultAll()
Dim arrData As Variant
Dim i As Long, j As Long, k As Long
Dim strName As String, strTeam As String, strTask As String
k = 1
arrData = Sheets("Source").Range("A1").CurrentRegion
With Sheets("Result").Range("A1")
.Offset(0, 0) = "Name"
.Offset(0, 1) = "Team"
.Offset(0, 2) = "Task"
For i = 2 To UBound(arrData, 1)
strName = arrData(i, 1)
strTeam = arrData(i, 2)
For j = 3 To UBound(arrData, 2)
If arrData(i, j) = 1 Then
.Offset(k, 0) = strName
.Offset(k, 1) = strTeam
.Offset(k, 2) = arrData(1, j)
k = k + 1
End If
Next j
Next i
End With
End Sub
Sub MakeResultforTeam()
Dim arrData As Variant
Dim i As Long, j As Long, k As Long
Dim strName As String, strTeam As String, strTask As String
arrData = Sheets("Source").Range("A1").CurrentRegion
If Sheets("Source").optAllDepartments.Value = True Then
strTeam = "All"
ElseIf Sheets("Source").optInternational.Value = True Then
strTeam = "International"
Else
strTeam = "Domestic"
End If
k = 1
With Sheets("Result").Range("A1")
.Offset(0, 0) = "Name"
.Offset(0, 1) = "Team"
.Offset(0, 2) = "Task"
If strTeam = "All" Then
For i = 2 To UBound(arrData, 1)
strName = arrData(i, 1)
strTeam = arrData(i, 2)
For j = 3 To UBound(arrData, 2)
If arrData(i, j) = 1 Then
.Offset(k, 0) = strName
.Offset(k, 1) = strTeam
.Offset(k, 2) = arrData(1, j)
k = k + 1
End If
Next j
Next i
ElseIf strTeam = "International" Then
For i = 2 To UBound(arrData, 1)
If arrData(i, 2) = strTeam Then
strName = arrData(i, 1)
For j = 3 To UBound(arrData, 2)
If arrData(i, j) = 1 Then
.Offset(k, 0) = strName
.Offset(k, 1) = strTeam
.Offset(k, 2) = arrData(1, j)
k = k + 1
End If
Next j
End If
Next i
Else
strTeam = "Domestic"
For i = 2 To UBound(arrData, 1)
If arrData(i, 2) = strTeam Then
strName = arrData(i, 1)
For j = 3 To UBound(arrData, 2)
If arrData(i, j) = 1 Then
.Offset(k, 0) = strName
.Offset(k, 1) = strTeam
.Offset(k, 2) = arrData(1, j)
k = k + 1
End If
Next j
End If
Next i
End If
End With
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.