Data manipulation

Billy12excel

New Member
Joined
Nov 17, 2010
Messages
42
Received data file per first sheet1, looking to manipulate
results to = second sheet 1

Excel Workbook
ABCD
1LEVEL of AttainmentNational Office RegionName Upper and LowerRanking Position & Dollar Amount #1
2Quadruple:
3Top LevelNorth District, ILAlbert Einstein#2 - Percent of Increase 6.0%
4Top LevelNorth District, ILAlbert Einstein#2 - Dollar Increase $2,745
5Top LevelNorth District, ILAlbert Einstein#2 New Members 10
6Top LevelNorth District, ILAlbert Einstein#1 Member Renewals 16
7etc,etc,
8
9Triple:
10Mid LevelSouth Valley District, ILTony Tgier#1 NM 105.56%
11Mid LevelSouth Valley District, ILTony Tgier#1 - Percent of Increase 15.6%
12Mid LevelSouth Valley District, ILTony Tgier#1 - Dollar Increase $9,737
13etc,etc,
14
15Double:
16Lower LevelCentral District, ILCarter Mann#2 New Members 6
17Lower LevelCentral District, ILCarter Mann#6 - APD $1,150
18etc,etc,
19
20Single:
21Bottom LevelCentral Distric, ILAlexander Jones#9 - APD $209
Sheet1
Excel Workbook
ABCDEFG
1LEVEL of AttainmentNational Office RegionName Upper and LowerRanking Position & Dollar Amount #1Ranking Position & Dollar Amount #2Ranking Position & Dollar Amount #3Ranking Position & Dollar Amount #4
2Quadruple:
3Top LevelNorth District, ILAlbert Einstein#2 - Percent of Increase 6.0%#2 - Dollar Increase $2,745#2 New Members 10#1 Member Renewals 16
4etc,etc,
5
6Triple:
7Mid LevelSouth Valley District, ILTony Tgier#1 NM 105.56%#1 - Percent of Increase 15.6%#1 - Dollar Increase $9,737
8etc,etc,
9
10Double:
11Lower LevelCentral District, ILCarter Mann#2 New Members 6#6 - APD $1,150
12etc,etc,
13
14Single
15Bottom LevelCentral Distric, ILAlexander Jones#9 - APD $209
16etc,etc,
17
18Ideally all levels saved to separate csv files
Excel 2000 Sheet1
Excel 2000


Ideally all levels saved to separate csv files

Thank you for any help!
 
Microsoft Visual Basic window, with Red X and 400 error. I keep trying,...

If you're prompted to select between 'End' and 'Debug', select 'Debug'. Does any line of code get highlighted? If so, which one?

Does a read only file ( it is ), then I save as new name effect it?

No, it should be fine...
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Run time error '1004" Cannot change part of a merged cell. debug = Range(Cells(1, "F"), Cells(1, Columns.Count)).EntireColumn.ClearContents Thank you!
 
Upvote 0
Run time error '1004" Cannot change part of a merged cell. debug = Range(Cells(1, "F"), Cells(1, Columns.Count)).EntireColumn.ClearContents Thank you!

If there's no data that needs to be cleared after Column E, remove the above line of code. Otherwise, prior to the above line of code, try adding the following...

Code:
Cells.MergeCells = False

Does this help?
 
Upvote 0
1st attempt. Removed, Range(Cells(1, "F"), Cells(1, Columns.Count)).EntireColumn.ClearContents 2nd attempt. Added Cells.MergeCells = False Both work on Single and Double as hoped for ( Excellent! ). Triple was missing "Ranking Position & Dollar Amount #3" Column. Quadruple was missing "Ranking Position & Dollar Amount #3" and "Ranking Position & Dollar Amount #4" I Can't help thinking it is that last hidden cell, ( see Post # 16 Sheet "Data as Received"), unhide will not work on it. Many many thanks!
 
Upvote 0
Try replacing...

Code:
Range(Cells(1, "F"), Cells(1, Columns.Count)).EntireColumn.ClearContents

with

Code:
With Range(Cells(1, "F"), Cells(1, Columns.Count)).EntireColumn
    .Hidden = False
    .ClearContents
End With
 
Upvote 0
Removed code, replaced it, = Run-time error 1004 "Cannot change part of a merged cell." debug = .clearcontents, deleted that, reran code: data seems to be where it is suppose to be, but, See Row 2 E-H; Which should be "Ranking Position & Dollar Amount #1" thru #4" Note: ZZ343 , BB231, and AB706 entries. Additionally, did not dump to test.csv files. Thank you!
Excel Workbook
ABCDEFGHI
14th Quarter 2010
2QuarterNameStateLevelRankingWriting #
3Quadruple Award:
44th Quarter 2010Person 1North District, ILBeginner#2 - Percent of Increase 6.0%#2 - Dollar Increase $2,745#2 New Members 16#1 Member Renewals 33ZZ343
5
6
7Triple Awards:
84th Quarter 2010Person 2West, IL2nd intermediate#1 ASES 105.56%#1 - Percent of Increase 11.0%#1 - Dollar Increase $2,737BB231
94th Quarter 2010Person 3So Central, ILLowerTop#3 - 1,501#2 - ASES 202.58%#1 XYZ $3,604AB706
Sheet1
Excel 2000
 
Upvote 0
Can you send me a sample file? If so, I'll send you my email address via Private message.
 
Upvote 0
Here's the revised code. By the way, it assumes that all records/rows for an individual with the same Quarter, State, and Level, are grouped together, as per your sample file.

Code:
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] CreateCSVFiles()

    [color=darkblue]Dim[/color] Categories [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Category [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] SourceRng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FoundCell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] LastColumn [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Rw [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    Cells.UnMerge
    
    Range("A1").Select
    
    Range("A1:E1").HorizontalAlignment = xlCenterAcrossSelection
    
    Range("D2").Value = UCase(Range("D2"))
    
    Columns("E").Replace what:="–", replacement:="-", lookat:=xlPart
    
    [color=darkblue]With[/color] Range(Cells(1, "F"), Cells(1, Columns.Count)).EntireColumn
        .Hidden = [color=darkblue]False[/color]
        .ClearContents
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Columns("E").Insert

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [color=darkblue]For[/color] i = 4 [color=darkblue]To[/color] LastRow
        [color=darkblue]If[/color] Cells(i, "C").Value <> "" [color=darkblue]Then[/color]
            Cells(i, "E").Value = Cells(i, "A").Value & "#" & Cells(i, "B").Value & "#" & Cells(i, "C").Value & "#" & Cells(i, "D").Value
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
    [color=darkblue]For[/color] i = LastRow [color=darkblue]To[/color] 4 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] Cells(i, "E").Value <> "" [color=darkblue]Then[/color]
            [color=darkblue]If[/color] Cells(i, "E").Value = Cells(i - 1, "E").Value [color=darkblue]Then[/color]
                [color=darkblue]Set[/color] SourceRng = Range(Cells(i, "F"), Cells(i, Columns.Count).End(xlToLeft))
                Cells(i - 1, "G").Resize(, SourceRng.Columns.Count).Value = SourceRng.Value
                Rows(i).Delete
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
    Columns("E").Delete
    
    [color=seagreen]'Change the path accordingly[/color]
    strPath = "C:\Users\Domenic\Desktop\Test\"
    
    [color=darkblue]If[/color] Right(strPath, 1) <> "\" [color=darkblue]Then[/color] strPath = strPath & "\"

    Categories = Array("Quadruple", "Triple", "Double", "Single")
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Category [color=darkblue]In[/color] Categories
        [color=darkblue]With[/color] Columns("A")
            [color=darkblue]Set[/color] FoundCell = .Find(Category, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
            [color=darkblue]If[/color] [color=darkblue]Not[/color] FoundCell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                [color=darkblue]Open[/color] strPath & Category & ".csv" [color=darkblue]For[/color] [color=darkblue]Output[/color] [color=darkblue]As[/color] #1
                    [color=darkblue]Write[/color] #1, "Name Upper and Lower";
                    [color=darkblue]Write[/color] #1, "National Office Region";
                    [color=darkblue]Write[/color] #1, "LEVEL of Attainment";
                    [color=darkblue]Select[/color] [color=darkblue]Case[/color] Category
                        [color=darkblue]Case[/color] "Quadruple"
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #1";
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #2";
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #3";
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #4"
                        [color=darkblue]Case[/color] "Triple"
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #1";
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #2";
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #3"
                        [color=darkblue]Case[/color] "Double"
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #1";
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #2"
                        [color=darkblue]Case[/color] "Single"
                            [color=darkblue]Write[/color] #1, "Ranking Position & Dollar Amount #1"
                    [color=darkblue]End[/color] [color=darkblue]Select[/color]
                    [color=darkblue]Set[/color] Cell = FoundCell.Offset(1, 1)
                    [color=darkblue]Do[/color] [color=darkblue]While[/color] Cell <> ""
                        Rw = Cell.Row
                        [color=darkblue]Write[/color] #1, Cells(Rw, "B").Value;
                        [color=darkblue]Write[/color] #1, Cells(Rw, "C").Value;
                        [color=darkblue]Write[/color] #1, Cells(Rw, "D").Value;
                        [color=darkblue]Select[/color] [color=darkblue]Case[/color] Category
                            [color=darkblue]Case[/color] "Quadruple"
                                [color=darkblue]Write[/color] #1, Cells(Rw, "E").Value;
                                [color=darkblue]Write[/color] #1, Cells(Rw, "F").Value;
                                [color=darkblue]Write[/color] #1, Cells(Rw, "G").Value;
                                [color=darkblue]Write[/color] #1, Cells(Rw, "H").Value
                            [color=darkblue]Case[/color] "Triple"
                                [color=darkblue]Write[/color] #1, Cells(Rw, "E").Value;
                                [color=darkblue]Write[/color] #1, Cells(Rw, "F").Value;
                                [color=darkblue]Write[/color] #1, Cells(Rw, "G").Value
                            [color=darkblue]Case[/color] "Double"
                                [color=darkblue]Write[/color] #1, Cells(Rw, "E").Value;
                                [color=darkblue]Write[/color] #1, Cells(Rw, "F").Value
                            [color=darkblue]Case[/color] "Single"
                                [color=darkblue]Write[/color] #1, Cells(Rw, "E").Value
                        [color=darkblue]End[/color] [color=darkblue]Select[/color]
                        [color=darkblue]Set[/color] Cell = Cell.Offset(1, 0)
                    [color=darkblue]Loop[/color]
                [color=darkblue]Close[/color] #1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Next[/color] Category
    
    Columns.AutoFit
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox "Completed...", vbInformation
                    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[/font]
 
Upvote 0
Good Evening Domenic, That worked great, I'm very grateful for your help. I am going to go over the code this weekend to see how to modify it for post #13 or very similar to it(top). I've scratched my head enough for tonight! But try I will. Thank you very much for your great patience with me. Hopefully, I can post success.
 
Upvote 0

Forum statistics

Threads
1,224,598
Messages
6,179,822
Members
452,946
Latest member
JoseDavid

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top