Search code examples
vbaexcelreportingautofilter

Excel VBA - Splitting data into report table

I'm after a bit of help automating a report for work.

I have a spreadsheet with a data dump on, as per screenshot below (this is some data I have mocked up for this example). This spreadsheet also has two other worksheets, one has a list of sales reps, the other has the basic template I need to achieve.

The data shows potential new business for our sales reps. This data is split down by sales rep, as well as a rating for the new business (hot, warm, lukewarm, general).

The template splits each reps data up into a separate table for each rating (i.e on the sheet for "Rep 1", it will have four tables, one for each rating. These tables will include everything for that rep for that rating).

One thing to note is that the tables should be dynamic, i.e sometimes there will be 3 lines of data, sometimes 20.

Each sales rep has a worksheet of their own which will eventually get emailed to them.

The below images shows my data layout, the reps sheet & my table template file.

My Data: Please note the real data set is much larger, i've just mocked this up for this example.DataImage

Reps list:RepsList

Template for output:TemplateOutput

I've been having a think about how itd work and so far I have the below:

  1. Create a new worksheet for Rep
  2. Filter Raw data by Rep 1 & "Hot"
  3. Copy data into the new WS
  4. Filter raw data by Rep 1 & "Warm"
  5. Copy data into new Ws
  6. Repeat for each rating..
  7. Format in the template style
  8. Save this WS to a new workbook & save with reps name (from rep sheet?)
  9. Repeat for each rep on the rep sheet.

Eventually the VBA would have created a new workbook for each rep that I can then automate emailing.

Any help is much appreciated. Unfortunately this is a bit over my head at the moment.

Edit:

So at present, I have split my raw data onto the individual rep sheets using the code below:

Sub SplitRep1()

    ActiveWorkbook.Sheets("Raw_Data").Activate
    ActiveSheet.Range("$A$1:$J$20000").AutoFilter Field:=2, Criteria1:="Rep1" 'Filters off Helen Passelow data
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select 'Ensures all data is selected
    Range(Selection, Selection.End(xlToRight)).Select 'Ensures all data is selected
    Selection.Copy
    ActiveWorkbook.Sheets("Rep1").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Raw_Data").Select
    ActiveSheet.Range("$A$1:$J$100000").AutoFilter Field:=2 'Resets autofilter
    Range("A1").Select

End Sub

I've replicated the above for each of the sales reps I have & it currently takes a couple of seconds to run.

The next part is where I get stuck. I have the template...Do I move my data into the preformatted template or sort my data then add the formatting?

My thoughts now would be to filter the individual rep sheet by Hot, Warm, Lukewarm, Cold etc, each time copying the data onto a new worksheet.

I would want to paste them onto my new WS, but in a specific order i.e Hot, Warm, Lukewarm, general (everything other than those listed previously). How would I ensure the next set of filtered data is entered after the current?

Edit2: I've added in some helper columns, each returns a true/false as to whether the criteria has been hit (hot, warm, cold etc).

I'm trying to loop through a filtered list, copying each line individually & placing it into the relevant place on my template file.

Solution

  • This is a bit long, but basically I think you should turn that data into coherent classes you can use later (for when you inevitably need to extend your tool). It also makes it conceptually easier to deal with. So, my classes, modeled on your data sets, go in "class modules" and look like:

    CCompany:

     Option Explicit

Private pname As String
Private pstatus As String
Private pvalue As Currency
Private pdate As Date
Private pNextDate As Date
Private pnumber As String
Private pemail As String
Private pcontact As String
Private pcontacttitle As String


Public Property Get name() As String
    name = pname
End Property

Public Property Get status() As String
    status = pstatus
End Property

Public Property Get Value() As Currency
    Value = pvalue
End Property

Public Property Get DateAdded() As Date
    ContactDate = pdate
End Property

Public Property Get NextContactDate() As Date
    NextContactDate = pNextDate
End Property

Public Property Get Number() As String
    Number = pnumber
End Property

Public Property Get Email() As String
    Email = pemail
End Property

Public Property Get Contact() As String
    Contact = pcontact
End Property

Public Property Get ContactTitle() As String
    ContactTitle = pcontacttitle
End Property

Public Property Let name(v As String)
    pname = v
End Property

Public Property Let status(v As String)
    pstatus = v
End Property

Public Property Let Value(v As Currency)
    pvalue = v
End Property

Public Property Let DateAdded(v As Date)
    pdate = v
End Property

Public Property Let NextContactDate(v As Date)
    pNextDate = v
End Property

Public Property Let Number(v As String)
    pnumber = v
End Property

Public Property Let Email(v As String)
    pemail = v
End Property

Public Property Let Contact(v As String)
    pcontact = v
End Property

Public Property Let ContactTitle(v As String)
    pcontacttitle = v
End Property

Public Sub WriteRow(ByRef wsSheet As Excel.Worksheet, row As Long, start_column As Long)
    wsSheet.Cells(row, start_column).Value = pdate
    wsSheet.Cells(row, start_column + 1).Value = pname
    wsSheet.Cells(row, start_column + 2).Value = pcontact
    wsSheet.Cells(row, start_column + 3).Value = pcontacttitle
    wsSheet.Cells(row, start_column + 4).Value = pnumber
    wsSheet.Cells(row, start_column + 5).Value = pemail
    wsSheet.Cells(row, start_column + 6).Value = pvalue
End Sub

    CRep:

    Private pname As String

Private pemail As String

Private pcompanies As New Collection

Public Property Get name() As String
    name = pname
End Property

Public Property Get Email() As String
    Email = pemail
End Property


Public Property Let name(v As String)
    pname = v
End Property

Public Property Let Email(v As String)
    pemail = v
End Property

Public Function AddCompany(company As CCompany)
    pcompanies.Add company
End Function

Public Function GetCompanyByName(name As String)
Dim i As Long

For i = 0 To pcompanies.Count
    If (pcompanies.Item(i).name = name) Then
        GetCompany = pcompanies.Item(i)
        Exit Function
    End If
Next i

End Function

Public Function GetCompanyByIndex(Index As Long)

GetCompanyByIndex = pcompanies.Item(Index)

End Function

Public Property Get CompanyCount() As Long
    CompanyCount = pcompanies.Count
End Property

Public Function RemoveCompany(Index As Long)
    pcompanies.Remove Index
End Function

Public Function GetCompaniesByStatus(status As String) As Collection
    Dim i As Long, col As New Collection

    For i = 1 To pcompanies.Count
        If pcompanies.Item(i).status = status Then col.Add pcompanies.Item(i)
    Next i
    Set GetCompaniesByStatus = col
End Function

    CReps (Collection class):

    Option Explicit
Private reps As Collection

Private Sub Class_Initialize()
    Set reps = New Collection
End Sub

Private Sub Class_Terminate()
    Set reps = Nothing
End Sub

Public Sub Add(obj As CRep)
    reps.Add obj
End Sub

Public Sub Remove(Index As Variant)
    reps.Remove Index
End Sub

Public Property Get Item(Index As Variant) As CRep
    Set Item = reps.Item(Index)
End Property

Property Get Count() As Long
    Count = reps.Count
End Property

Public Sub Clear()
    Set reps = New Collection
End Sub

Public Function GetRep(name As String) As CRep
    Dim i As Long

    For i = 1 To reps.Count
        If (reps.Item(i).name = name) Then
            Set GetRep = reps.Item(i)
            Exit Function
        End If
    Next i
End Function

    I made a workbook based on your data, and then added the following code modules:

    Option Explicit

Public Function GetLastRow(ByRef wsSheet As Excel.Worksheet, ByVal column As Long) As Long
    GetLastRow = wsSheet.Cells(wsSheet.Rows.Count, column).End(xlUp).row
End Function

Public Function GetReps() As CReps
    Dim x As Long, i As Long, col As New CReps, rep As CRep

    x = GetLastRow(Sheet2, 1)

    For i = 2 To x 'ignore headers
        Set rep = New CRep
        rep.name = Sheet2.Cells(i, 1).Value 'Sheet2 is the sheet with my rep list in - I'm using the variable name, as it appears in the properties window
        rep.Email = Sheet2.Cells(i, 2).Value
        col.Add rep
    Next i

    Set GetReps = col

End Function

Public Sub GetData(ByRef reps As CReps)

Dim x As Long, i As Long, rep As CRep, company As CCompany

    x = GetLastRow(Sheet1, 1)

    For i = 2 To x
        Set rep = reps.GetRep(Sheet1.Cells(i, 2).Value)
        If Not IsNull(rep) Then
            Set company = New CCompany
            company.name = Sheet1.Cells(i, 1).Value 'Sheet1 is where I put my company data
            company.status = Sheet1.Cells(i, 3).Value
            company.Value = Sheet1.Cells(i, 4).Value
            company.DateAdded = Sheet1.Cells(i, 5).Value
            company.NextContactDate = Sheet1.Cells(i, 6).Value
            company.Number = Sheet1.Cells(i, 7).Value
            company.Email = Sheet1.Cells(i, 8).Value
            company.Contact = Sheet1.Cells(i, 9).Value
            company.ContactTitle = Sheet1.Cells(i, 10).Value
            rep.AddCompany company
        End If
    Next i

End Sub


Public Sub WriteData(ByRef wsSheet As Excel.Worksheet, ByRef rep As CRep)

Dim x As Long, col As Collection

x = 2
Set col = rep.GetCompaniesByStatus("Hot")
write_col wsSheet, col, x, 1

x = x + col.Count + 2
Set col = rep.GetCompaniesByStatus("Warm")
write_col wsSheet, col, x, 1

x = x + col.Count + 2
Set col = rep.GetCompaniesByStatus("Lukewarm")
write_col wsSheet, col, x, 1

x = x + col.Count + 2
Set col = rep.GetCompaniesByStatus("General")
write_col wsSheet, col, x, 1



End Sub


Private Sub write_col(ByRef wsSheet As Excel.Worksheet, col As Collection, row As Long, column As Long)
    Dim i As Long, company As CCompany
    For i = 1 To col.Count
        Set company = col.Item(i)
        company.WriteRow wsSheet, row + (i - 1), column
    Next i
End Sub

    And:

    Public Sub DoWork()

Dim reps As CReps, i As Long, wsSheet As Excel.Worksheet

Set reps = GetReps

GetData reps

For i = 1 To reps.Count
    Set wsSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    WriteData wsSheet, reps.Item(i)
Next i

End Sub

    So, basically I've made classes which encapsulate your data, added some macros for reading in data from a worksheet (it assumes you have headers in your tables, like your example), and one that dumps that data out to a specified worksheet (you'll need to add the correct formatting). That worksheet can be in any workbook you can write to. The final module is just a usage example, showing how to load in the data, and write it out to sheets in the same workbook. For larger datasets, you may want to avoid repeated writes to the workbook, and lift all the data up into an array before working on it.

    Sorry for lack of comments - I intend to add more later.