Data filtered by series which must to be copied in other sheets

I am working with a VB code in an excel file, I have data in Sheet1 with several rows (now are 10,000, but could be more or less). In Sheet1 from column A to Column F are data that I want to copy and paste in other sheets (no formulas there are in sheet1), but Sheet1 have also Column G where data is categorized by series from 1 to X depending of how many lines because the data cannot be greater than 940 lines, in this sense in this example I have 11 series. What I want to do? I want to filter column G by series starting in series 1 until last series (11). For filter the series 1 in column G, I want to copy and paste the data in sheet1 from Column A to F to other sheet (could be labeled JV1), then when I filter column G by series 2, I want to copy and paste from A to F in other sheet (could be labeled JV2), then when I filter column G for series 3, I want to copy and paste from A to F in other sheet (could be labeled JV3), In each these sheets (JV1, JV2, JV3) the data from Sheet1 have to be copied in cell A20. My concern it is how can I do for that once I filter column G by each series, it will be copied in several sheets which must to be named as JV1, JV2, JV3......until last series in column G that now is 11?, Series in column G could be less or more than 11. I do not know if it can be coded using "while", "Do" FOR", etc. Any idea on this code will be appreciated.

Thread moved to the 'Office Development/VBA' forum... note that while it certainly isn't made clear, the "VB Editor" in Office programs is actually VBA rather than VB, so the 'VB6' forum is not really apt

See if the attached gets you close to what you're looking for.

(Excel 2010)

Hi VbFbryce, I tested your code with my template that contain has 3 categories and only were created correctly JV1 and JV2, but JV3 or last one was missing. I ran your file sent to me and you have six categories and macro only cretaed five JV, the last one in your file JV6 also was missing, so I think there is something is failing in your coding for last JV.
Thanks in advance
Note: I sent a previous reply you but apparently has not posted, it is related to that all JV must to start in row 24. Row 1 thru row 23 have to be standard header information basically in Column A and some in other columns between row 1 thru row 23. I would you give an example to write the codes for this standard header data that mmust to have all JVx created.
Thanks in advance.

Hi, such as I mentioned you coding is failing for category of last JV. Please see the file enclosed in order you can to test your coding, it contain three categories in Column "M", (not "G" as I had wrote), also data to move from sheet "main" is from Column A thru J and not as I had wrote, sorry about it. I have included a sheet named " header template of JV" because data to copy in JVx must to start in row 24, row 1 thru row 23 must contain what you can see in this sheet which will be standard for all JVx. I Hope it help you for coding purposes, but I am confident that you are in right way because your coding worked almost perfect except for the last category that ios being missing, also this issue is in the file that you sent me.
Thanks in advance.

Ok, I will check it out shortly. Bryce

Here is updated code with 2 changes: 1) paste the 6th category (in my case), and 2) paste to each new sheet starting at A24, not A1:

Code:

---

Sub cat()
    Dim wb As Workbook
    Dim wsMain As Worksheet
    Dim wsTarget As Worksheet
    Dim rngMain As Range
    Dim rngCopy As Range
    Dim lastRow As Long
    Dim catNo  'category number
    Dim i As Long
    Dim currCat As String  'current category
    Dim rowStart As Long
    Dim rowEnd As Long
    Dim shtNew As String
    Dim shtCount As Integer
   
    Set wb = Workbooks("CopyDataByCategory.xlsm")
    Set wsMain = wb.Worksheets("main")
    lastRow = wsMain.Range("g1").End(xlDown).Row
    Set rngMain = wsMain.Range("a1", "g" & lastRow)
    wsMain.Sort.SortFields.Clear
    wsMain.Sort.SortFields.Add Key:=Range("g2", "g" & lastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsMain.Sort
        .SetRange Range("a1", "g" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    rowStart = 2
    currCat = wsMain.Range("g" & rowStart).Value
    For i = 2 To lastRow + 1  '*************** added the  "+ 1" here ******************
        If i > rowStart Then
            If wsMain.Range("g" & i).Value <> wsMain.Range("g" & rowStart).Value Then
                'found the next category
                rowEnd = i - 1
                shtNew = "JV" & currCat
                shtCount = wb.Worksheets.Count
                Set wsTarget = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
                wb.Worksheets(shtCount + 1).Name = shtNew
                wsMain.Range("a" & rowStart, "f" & rowEnd).Copy
                wsTarget.Range("a24").PasteSpecial      'pastes to A24 now *******************************
                rowStart = rowEnd + 1
                currCat = wsMain.Range("g" & rowStart).Value
                i = i - 1
                Application.CutCopyMode = False
            End If

        End If
    Next i
    wsMain.Select
End Sub

---

My code is contingent on having the "category value" in column G, but I don't see values in that column on your template, unless I'm missing it?

Hi Bryce, now it is working perfectly which for me is a great advance. Nevertheless I would like you could to look at into file that I sent you the possibility to create a coding for copy and paste row 1 thru row 23 in each JVx created with code above from Sheet named "JVupload Form" that I sent in my file labeled "example_template". Thanks in advance for your help.

Hi Bryce, I can to find a code for second part of my template. Really I appreciate what you did for me. The code was the follow:

Sheets("JVUpload Form").Rows("1:23").Copy
shtNew = "JV" & currJVupload
Range("A1").PasteSpecial

Lucianir,

You're welcome!

So is it now doing everything you need, or do you still need something looked at?

I couldn't quite figure out how to translate my example to fit your template.

Bryce

Bryce, not problem the thing it is that your code works perfectly, only I have a concern about it and is if there is a way to change the code without do reference to the name of the excel file or "worksheet name.xlsm" it is because this template needs be re-named every month and will be great has not a code where is the name of the excel file to avoid that the macro stop.
Thanks in advance.

You could use the "activeworkbook, activesheet" type of approach, or you could use an input box to provide the name of it for that month.

Bryce

I will do, in case that I decide to use an input box, have I place at the end of the file name, the excel extension like .xls, .xlsm, etc?

For example:

Code:

---

Sub myInput()
    Dim userInput As String
   
    userInput = inputbox("Enter sheet name:", "Sheet Name Input")
   
    userInput = userInput & ".xlsx"
   
    MsgBox userInput
   
End Sub

---

Hi Bryce, I did a coding for input box a little different as you wrote above and it works fine, but I am seen that this option it is not best way for this project, I have tried to change using "ActiveWorkbook.Worksheets", but I have had problems for this way, can you send me the coding using this option (activeWorkbook.Worksheets")? I will appreciate your help on this. Thanks in advance.

For example:

Code:

---

Sub activeWS()
    Dim bookName As String
    Dim sheetName As String
   
    bookName = ActiveWorkbook.Name
    sheetName = ActiveWorkbook.ActiveSheet.Name
    MsgBox "book: " & bookName & ", sheet: " & sheetName
End Sub

---

Hi Bryce, probably I do not explain well what I want to do, but I want on first coding that send me the same routine but without coding "Set wb = Workbooks("CopyDataByCategory.xlsm")", such I say you with input box I can skip this, but then I need to put every time that I run the macro the name of the file, I want to avoid it, I want that macro run recognizing the active file excel name. Can you place in the same coding that you send me first, the coding as I am meaning?
Thanks in advance

The code in my previous post shows how to get the name of the active workbook and save it for future use. Is that not what you are wanting to do?

If something else, please explain further, thanks!

Hi Bryce, I am refering on first code that you send me on October 08, I would like to sustitute the option to "Set wb = Workbooks("CopyDataByCategory.xlsm")" for ActiveWorksheet, the thing is where I have to insert the last code that you have mentioned on first code, I do not know if you can to insert this short code in your entire code sent by you. Sorry about if I have missunderstand you.

Last, I have a dilema on this project, you have created an excelent code for open new sheets labeled as JV1, JV2, JV3......JVx, the thing is that I need totalize values in cell L17 of each JVx and put this total in cell Q1 of "sheet1", I mean destination of SUM of Cells L17 each JV it is cell Q1 of Sheet1. Do you think it is doable? The problem that I see it is that I do not know how many JVx could have because it depend of categories which may change or vary. Thanks in advance.

Insert the non specific workbook name code like this:

Code:

---

Dim shtNew As String
    Dim shtCount As Integer
   
    '*********** changed Sept 25 ****************************************************************
    'Set wb = Workbooks("CopyDataByCategory.xlsm")  'commented this line out
    Set wb = ActiveWorkbook    '*************    added this line    *********
    Set wsMain = wb.Worksheets("main")  'you might need to change this line to "=wb.worksheets(1)
    '********************************************************************************************
   
    lastRow = wsMain.Range("g1").End(xlDown).Row
    Set rngMain = wsMain.Range("a1", "g" & lastRow)

---

Then add this to the bottom of the code:

Code:

---

wsTarget.Range("a1").PasteSpecial
                rowStart = rowEnd + 1
                currCat = wsMain.Range("g" & rowStart).Value
                i = i - 1
                Application.CutCopyMode = False
            End If

        End If
    Next i
   
    '*************** added Sept 25 ************************
    Dim tempTotal As Long
   
    For i = 1 To wb.Worksheets.Count
        If Left(wb.Worksheets(i).Name, 2) = "JV" Then
            tempTotal = wb.Worksheets(i).Range("l17").Value
        End If
    Next i
    wb.Worksheets("main").Range("q1").Value = tempTotal
   
    '******************************************************
   
    wsMain.Select

---

Bryce, thanks you so much, but I am having an error warning message that says "Compile error: For control variable already in use", then beginning the statement "For 1 = 1 To" is shaded in blue color. Do you know what could be happening?
Thanks in advance

Hi never mind, I find what problem is but the code now is partially working because in cell Q1 of sheet1 (or main) is showing the value of cell L17 in the last JV sheet, is not doing SUM function of all cells in JVx, I want that in cell Q1 of sheet1 will be showed do something as: =+'JV1'!L17+'JV2'!L17+'JV3'!L17+'JV4'!L17........, I means SUM function for each cell L17 in each JVx

Should show you the sum of all JV's but let me check that part out.

Sorry, should have been this:

Code:

---

If Left(wb.Worksheets(i).Name, 2) = "JV" Then
            tempTotal = tempTotal + wb.Worksheets(i).Range("l17").Value  '***** changed this line ****
        End If

---

Bryce, thank you so much it is working only that value in cell "Q1" of sheet1 is showed with rounding with cero decimal (cells "L17" in JVx has two decimals place), How could to do that this value in Q1 will be showed with two decimals place? Thanks in advance.

Toward the very end of the code, change to this:

wb.Worksheets("main").Range("q1").Value = Format(tempTotal, "#.#0")

Hi Bryce, I put your code at the end of you original code and in cell Q1 is being showed the amount with format of two decimals places, but the value is coming truncated without decimals (as integer) from JVs sheets, so value is with as integer with decimals. For instance the view of cell is as 8,250,300.00, but inside cell is as 8250300.
Thanks in advance.

Sorry I did a typo, "so value is as integer without decimals"

Gotcha. Try this change:

Code:

---

'*************** added Sept 25 ************************
    'Dim tempTotal As Long
    Dim tempTotal As Single
   
    For i = 1 To wb.Worksheets.Count
        If Left(wb.Worksheets(i).Name, 2) = "JV" Then
            tempTotal = tempTotal + wb.Worksheets(i).Range("l17").Value
        End If
    Next i
    wb.Worksheets("main").Range("q1").Value = Format(tempTotal, "#.#0")

   
    '******************************************************

---