Xtreme Visual Basic Talk

Xtreme Visual Basic Talk (http://www.xtremevbtalk.com/)
-   .NET Office Automation (http://www.xtremevbtalk.com/-net-office-automation/)
-   -   Split main sheet into multiple sheets using VB 2010 inserting too many sheets (http://www.xtremevbtalk.com/-net-office-automation/327898-split-main-sheet-multiple-sheets-using-vb-2010-inserting-sheets.html)

jtammyg 10-28-2015 12:52 PM

Split main sheet into multiple sheets using VB 2010 inserting too many sheets
 
Hi!

I'm trying to split sheet called "Temp", into multiple sheets depending on change of column A.

My below code is adding 28 sheets which is way too many, since there is only 14 hospitals. Plus the first sheets which has other data and the temp sheet where is the actual data that gets filter.

So it has 1 sheet with hospital A, leaves one sheet blank, adds another sheet with hospital B, leaves ones blank etc.

It is also adding each of the hospitals data into the first sheet which is called "FQHCs Overall Measure Summary" and already has data in it and doesn't need to be touched.

My purpose is to add a sheet and paste there the hospital A data, add another sheet and onto that one paste hospital B data, add another sheet and paste hospital C data, etc.

Here is the code:

Code:


 Dim r As Excel.Range, r1 As Excel.Range, r2 As Excel.Range
        Dim c2 As Excel.Range
        Dim wks1 As Excel.Worksheet = xlWorkBookFQHCs.Worksheets("Sheet2")
        Dim wks2 As Excel.Worksheet

        wks1.Activate()
        wks1.Name = "Temp"
        r = wks1.Range(wks1.Range("A1"), wks1.Range("A1").End(Excel.XlDirection.xlDown))
        r1 = wks1.Range("A1").End(Excel.XlDirection.xlDown).Offset(1, 0)
        wks1.AutoFilterMode = False
        r.AdvancedFilter(Action:=Excel.XlFilterAction.xlFilterCopy, CopyToRange:=r1, Unique:=True)
        r2 = wks1.Range(r1.Offset(1, 0), r1.End(Excel.XlDirection.xlDown))
        If wks1.Name <> "Temp" Or wks1.Name <> "FQHCs Overall Measure Summary" Then
            For Each c2 In r2

                For intCount = 1 To 2
                    wks2 = xlWorkBookFQHCs.Worksheets.Add(After:=xlWorkBookFQHCs.Worksheets(intCount))
                    r.CurrentRegion.AutoFilter(Field:=1, Criteria1:=c2.Value)
                    r.CurrentRegion.Cells.SpecialCells(Excel.XlCellType.xlCellTypeVisible).Copy()

                    xlWorkBookFQHCs.Worksheets(intCount).Cells(wks1.Rows.Count, "A").End(Excel.XlDirection.xlUp).Offset(0, 0).PasteSpecial()

                    wks1.Activate()
                    'r.CurrentRegion.AutoFilter()
                    wks1.AutoFilterMode = False
                Next
            Next c2

        End If

What am I doing wrong?????

Someone please help.



Thanks a lot!

Tammy


All times are GMT -6. The time now is 08:23 PM.

Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Search Engine Optimisation provided by DragonByte SEO v2.0.15 (Lite) - vBulletin Mods & Addons Copyright © 2017 DragonByte Technologies Ltd.
All site content is protected by the Digital Millenium Act of 1998. Copyright©2001-2011 MAS Media Inc. and Extreme Visual Basic Forum. All rights reserved.
You may not copy or reproduce any portion of this site without written consent.