0

Thanks to you guys and some developers at my work that have helped, I am almost done with a project my boss gave me. I'm a QA -- not a developer -- so my VB scripting expertise is non-existent.

Here's my problem. I have the script below that will take master data from a sales budgeting spreadsheet for every customer in every account in every region. The code below create a new worksheet for every account and save it by the account name. In that worksheet, it will create a new sheet for every salesman. The two issues I am running in to are that the first column (called Rank) is filtering by descending order instead of ascending order. for example A:2 is 44 where A:2 should be 1, A:3 should be 2, A:4 should be 3, A:5 should be 4, etc..

That leads to my second question. How do I get the first row in each spreadsheet to be a header? I want everything in Row 1 of the source worksheet to be row 1 in every worksheet it creates. Here are the rows I want:

Rank

CUSTOMER_SEGMENT

ALIAS_NAME (Branch)

SUPERVISOR_NAME

Salesrep Name

MAIN_CUSTOMER_NK

Customer

Sales

Inv Cost GP

Inv Cost GP%

Sales Growth

"GP Point Change"

YTDLY_SALES

YTDLY_INVOICE_COST_GP

I did a search before posting this, and I found two links that might help me. However, I am a novice and can't understand where I would insert the code in to my existing script below.

Setting Column Headers When Adding Columns To a Table Via Macro in Excel

Add headers to column data using a macro

Please forgive me if the code doesn't come over right. I'm new to stackoverflow's formatting.\

' get a named worksheet from specified workbook, creating it if required
Public Function GetSheet(ByVal Name As String, ByVal Book As Workbook, Optional ByVal Ignore As Boolean = False) As Worksheet
Dim Sheet As Worksheet
Dim Key As String
Dim Result As Worksheet: Set Result = Nothing

    Key = UCase(Name)

    ' loop over all the worksheets
    For Each Sheet In Book.Worksheets
        ' break out of the loop if the sheet is found
        If UCase(Sheet.Name) = Key Then
            Set Result = Sheet
            Exit For
        End If
    Next Sheet

    ' if the sheet isn't found..
    If Result Is Nothing Then
        If Ignore = False Then
            If Not GetSheet("Sheet1", Book, True) Is Nothing Then
                ' rename sheet1
                Set Result = Book.Worksheets("Sheet1")
                Result.Name = Name
            End If
        Else
            ' create a new sheet
            Set Result = Book.Worksheets.Add
            Result.Name = Name
        End If
    End If

    Set GetSheet = Result

    End Function
Sub Main()
Dim Source As Worksheet
Dim Location As Workbook
Dim Sales As Worksheet
Dim LocationKey As String
Dim SalesKey As String
Dim Index As Variant
Dim Map As Object: Set Map = CreateObject("Scripting.Dictionary")
Dim Row As Long

    Set Source = ThisWorkbook.ActiveSheet

    Row = 2 ' Skip header row

    Do
        ' break out of the loop - assumes that the first empty row signifies the end
        If Source.Cells(Row, 1).Value2 = "" Then
            Exit Do
        End If

        LocationKey = Source.Cells(Row, 3).Value2

        ' look at the location, and find the workbook, creating it if required
        If Map.Exists(LocationKey) Then
            Set Location = Map(LocationKey)
        Else
            Set Location = Application.Workbooks.Add(xlWBATWorksheet)
            Map.Add LocationKey, Location
        End If

        SalesKey = Source.Cells(Row, 5).Value2

        ' get the sheet for the salesperson
        Set Sales = GetSheet(SalesKey, Location)

        ' insert a blank row at row 1
        Sales.Rows(1).Insert xlShiftDown

        ' populate said row with the data from the source
        Sales.Cells(1, 1).Value2 = Source.Cells(Row, 1)
        Sales.Cells(1, 2).Value2 = Source.Cells(Row, 2)
        Sales.Cells(1, 3).Value2 = Source.Cells(Row, 4)
        Sales.Cells(1, 4).Value2 = Source.Cells(Row, 6)
        Sales.Cells(1, 5).Value2 = Source.Cells(Row, 7)
        Sales.Cells(1, 6).Value2 = Source.Cells(Row, 8)
        Sales.Cells(1, 7).Value2 = Source.Cells(Row, 9)
        Sales.Cells(1, 8).Value2 = Source.Cells(Row, 10)
        Sales.Cells(1, 9).Value2 = Source.Cells(Row, 11)
        Sales.Cells(1, 10).Value2 = Source.Cells(Row, 12)

        'increment the loop
        Row = Row + 1
    Loop

    ' loop over the resulting workbooks and save them - using the location name as file name
    For Each Index In Map.Keys
        Set Location = Map(Index)
        Location.SaveAs Filename:=Index
    Next Index

End Sub

Here is the sample data from a CSV:

Rank,CUSTOMER_SEGMENT,ALIAS_NAME (Branch),SUPERVISOR_NAME,Salesrep Name,MAIN_CUSTOMER_NK,Customer,Sales,Inv Cost GP,Inv Cost GP%,Sales Growth,"GP Point Change",YTDLY_SALES,YTDLY_INVOICE_COST_GP 1,TOP 20,Branch1,super1,SR1,416469,3456,886394.26,211430.39,24%,-16%,1%,1056822.44,243333.25 2,TOP 20,Branch1,super1,SR1,223391,3456789,840048.49,112204.26,13%,26%,-4%,667457.3,115063.42 3,TOP 20,Branch1,super1,SR1,10299,9876,695652.09,88839.65,13%,7%,-2%,648249.35,95599.75 4,TOP 20,Branch1,super1,SR1,430884,23489,677324.34,91479.62,14%,190%,-2%,233935.32,36550.6 5,TOP 20,Branch2,super2,SR2,415886,89,430334.02,54701.73,13%,-22%,-2%,551546.33,80682.7 6,TOP 20,Branch2,super2,SR2,48793,234679,349611.36,61979.82,18%,-6%,2%,370575.07,59370.36 7,TOP 20,Branch2,super2,SR2,433979,2389,323587.09,49952.25,15%,-25%,3%,431745.94,53394.42 8,TOP 20,Branch2,super2,SR2,417290,3565850,304622.89,76255.75,25%,6%,5%,287953.73,57085.9 9,TOP 20,Branch2,super2,SR2,416986,9880,302111.92,45050.53,15%,46%,-1%,207067.31,32645.16 10,TOP 20,Branch2,super2,SR2,415811,8364859,252760.38,51374.19,20%,-7%,2%,271975.58,49567.85 11,TOP 20,Branch3,super3,SR3,428608,7369,238166.05,37761.17,16%,-24%,-1%,314515.42,54352.07 12,TOP 20,Branch3,super3,SR3,416363,980897987,237122.47,33682.5,14%,18%,-6%,201038.61,39941.88 13,TOP 20,Branch3,super3,SR3,428631,2345689,216378.99,25943.35,12%,-37%,-4%,340909.56,54078.63 14,TOP 20,Branch3,super3,SR3,423212,123456789,193417.5,37101.67,19%,21%,1%,160318.29,29070.35

Improve this question

2 Answers 2

Reset to default
1

I have made a few amendments for you to try. Please note that I have not been able to test this as I don't have the workbook that you are working on. I have put my initials (CP) in comments where I have made changes with a brief explanation. Let me know if you have any issues:

Option Explicit

' get a named worksheet from specified workbook, creating it if required
Public Function GetSheet(ByVal Name As String, ByVal Book As Workbook, Optional ByVal Ignore As Boolean = False) As Worksheet
    Dim Sheet As Worksheet
    Dim Key As String
    Dim Result As Worksheet: Set Result = Nothing

    Key = UCase(Name)

    ' loop over all the worksheets
    For Each Sheet In Book.Worksheets
        ' break out of the loop if the sheet is found
        If UCase(Sheet.Name) = Key Then
            Set Result = Sheet
            Exit For
        End If
    Next Sheet

    ' if the sheet isn't found..
    If Result Is Nothing Then
        If Ignore = False Then
            If Not GetSheet("Sheet1", Book, True) Is Nothing Then
                ' rename sheet1
                Set Result = Book.Worksheets("Sheet1")
                Result.Name = Name
            End If
        Else
            ' create a new sheet
            Set Result = Book.Worksheets.add
            Result.Name = Name
        End If
    End If

    Set GetSheet = Result

    End Function


Sub Main()
    Dim Source As Worksheet
    Dim Location As Workbook
    Dim Sales As Worksheet
    Dim LocationKey As String
    Dim SalesKey As String
    Dim Index As Variant
    Dim Map As Object: Set Map = CreateObject("Scripting.Dictionary")
    Dim Row As Long

    Set Source = ThisWorkbook.ActiveSheet

    Row = 1 ' CP changed to not exclude header row

    Do
        ' break out of the loop - assumes that the first empty row signifies the end
        If Source.Cells(Row, 1).Value2 = "" Then
            Exit Do
        End If

        LocationKey = Source.Cells(Row, 3).Value2

        ' look at the location, and find the workbook, creating it if required
        If Map.Exists(LocationKey) Then
            Set Location = Map(LocationKey)
        Else
            Set Location = Application.Workbooks.add(xlWBATWorksheet)
            Map.add LocationKey, Location
        End If

        SalesKey = Source.Cells(Row, 5).Value2

        ' get the sheet for the salesperson
        Set Sales = GetSheet(SalesKey, Location)

        ' insert a blank row at row 1
        'Sales.Rows(1).Insert xlShiftDown ' CP this was causing the reversal

        ' populate said row with the data from the source
        ' CP changed to copy to appropriate row
        Sales.Cells(Row, 1).Value2 = Source.Cells(Row, 1)
        Sales.Cells(Row, 2).Value2 = Source.Cells(Row, 2)
        Sales.Cells(Row, 3).Value2 = Source.Cells(Row, 4)
        Sales.Cells(Row, 4).Value2 = Source.Cells(Row, 6)
        Sales.Cells(Row, 5).Value2 = Source.Cells(Row, 7)
        Sales.Cells(Row, 6).Value2 = Source.Cells(Row, 8)
        Sales.Cells(Row, 7).Value2 = Source.Cells(Row, 9)
        Sales.Cells(Row, 8).Value2 = Source.Cells(Row, 10)
        Sales.Cells(Row, 9).Value2 = Source.Cells(Row, 11)
        Sales.Cells(Row, 10).Value2 = Source.Cells(Row, 12)

        'increment the loop
        Row = Row + 1
    Loop

    ' loop over the resulting workbooks and save them - using the location name as file name
    For Each Index In Map.Keys
        Set Location = Map(Index)
        Location.SaveAs filename:=Index
    Next Index

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

6 Comments

Thanks, Chris. I tried that and it created a bunch of blank pages. I see you updated this section: Sales.Cells(Row, 1).Value2 = Source.Cells(Row, 1) Sales.Cells(Row, 2).Value2 = Source.Cells(Row, 2) Sales.Cells(Row, 3).Value2 = Source.Cells(Row, 4) Sales.Cells(Row, 4).Value2 = Source.Cells(Row, 6) Sales.Cells(Row, 5).Value2 = Source.Cells(Row, 7) Sales.Cells(Row, 6).Value2 = Source.Cells(Row, 8) Does anything need to change elsewhere to reflect the change to the first row?
Okay here's what it's doing when we change Row to 1. It is seeing row 2 as a different Account (branch) and creating a new sheet that works exactly the same as it did before.
Okay, sorry about that. This is a little tricky to get right without having the actual data to work on. Are you able to post a sample of the data that I could paste into a workbook for testing?
I'm not exactly sure how. here is a screen shot: tinypic.com/r/1zpgvns/5
One way would be to save a copy as .CSV, right click the .CSV file and open with a text editor such as notepad to copy the data, then edit your question and paste the sample data onto the end. I will then be able to use Excel to split the comma delimited data into columns. Another way would be to create an account with a cloud storage provider such as Dropbox, make a folder public and upload the spreadsheet to there and then provide the link.
|
0

In your code that creates a new worksheet, set the header there:

result.cells(1,1)="header 1"
result.cells(1,2)="header 2"
result.cells(1,3)="header 3"
....

In the code that adds the line, you are currently inserting a row, which shifts the rest down, and has the effect of reversing the order. To overcome this, we need to find which row to add the new line to.
First, dim the variable we will be using

Dim InsertPos as long

Then we have to decide what line we need to place the data..

' get the sheet for the salesperson
Set Sales = GetSheet(SalesKey, Location)

' Get the location to enter the data
InsertPos = Sales.Range("A1").End(xlDown).Row + 1

'check to see if it's a new sheet, and adjust
if InsertPos=1048577 then InsertPos=2
'change to 65537 is using excel 2003 or before

now we can put the data into the sheet in the order in which it is read

' populate said row with the data from the source
Sales.Cells(InsertPos, 1).Value2 = Source.Cells(Row, 1)
Sales.Cells(InsertPos, 2).Value2 = Source.Cells(Row, 2)
Sales.Cells(InsertPos, 3).Value2 = Source.Cells(Row, 4)
....
Improve this answer

4 Comments

Sean, thank you. Please understand that I have zero idea of how to do that. I can cut and paste, see how it works, and then tweak it from there if I need to, but as far as format and where to put things . . . I'm lost. So is this a range you're putting in there? Do I do the Dim InsertPos as long where I have all this: Sub Main() Dim Source As Worksheet Dim Location As Workbook Dim Sales As Worksheet Dim LocationKey As String Dim SalesKey As String Dim Index As Variant Dim Map As Object: Set Map = CreateObject("Scripting.Dictionary") Dim Row As Long
Okay. And when you do Sales.Cells(InsertPos, 1).Value2 = Source.Cells(Row, 1) and so on . . . where do I put that? Is it before or after Sales.Rows(1).Insert xlShiftDown? Do I even still need Sales.Rows(1).Insert xlShiftDown since we are doing InsertPos = Sales.Range("A1").End(xlDown).Row + 1?
Oh. Where do I put the result.cells(1,1) = "header1" statements?
@JackPrible, here's what the code would look like: pastebin.com/LEVXbjt4 I'm not typing all the headers, etc., but it's much the same as you have now

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.