Is there a way to make this more generic?

bigairman

New Member
Joined
Jul 25, 2007
Messages
13
I have looked everywhere for a solution making this macro code more generic, but havent had any luck.

What this code does is take a workbook, update columns (either adding or removing), merging all the sheets, and then removing all other sheets when done. The problem is, currently it has named worksheets and it errors out if there is either a different worksheet in the workbook, or if one is missing.

Also, it seems as though there are several requirements for this that are getting in the way. The first issue is that ideally it should not care if there are 1 sheet or 50, and the second is the fact that some sheets have all the required columns and some dont.

Does anyone have any ideas? Here is what I currently have for code:

Sub CDM_Data_Feed()

'-----update columns-----
Application.ScreenUpdating = False

ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("2007 - Golf Bags and Accessorie").Select
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("F:AM").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 1
Range("A1:A2").Select
Range("A2").Activate
Sheets("2007 - Golf Balls - USA").Select
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("F:AM").Select
Selection.Delete Shift:=xlToLeft
Sheets("2007 - Golf Club Catalog - US").Select
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("F:AP").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Sheets("2007 - Golf Club Catalog - USA ").Select
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("F:AP").Select
Selection.Delete Shift:=xlToLeft
Sheets("2007 - Golf Footwear - USA").Select
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("F:BC").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 1
Sheets("2007 - Golf Gloves - USA").Select
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("F:AR").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 1
Sheets("2007-Golf Apparel-SP-SU").Select
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:P").Select
Selection.Delete Shift:=xlToLeft
Columns("F:BH").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Sheets("2007-Golf Apparel-Fall-Hol").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 2
Columns("E:P").Select
Selection.Delete Shift:=xlToLeft
Columns("F:BH").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("2007 - Golf Bags and Accessorie").Select

' -----Merge sheets-----
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("2007 - Golf Bags and Accessorie", "2007 - Golf Balls - USA", _
"2007 - Golf Club Catalog - US", "2007 - Golf Club Catalog - USA ", _
"2007 - Golf Footwear - USA", "2007 - Golf Gloves - USA", _
"2007-Golf Apparel-SP-SU", "2007-Golf Apparel-Fall-Hol")).Select
Sheets("2007 - Golf Bags and Accessorie").Activate

Const NHR = 1 'Number of header rows to not copy from each MWS

Dim MWS As Worksheet 'Worksheet to be merged
Dim AWS As Worksheet 'Worksheet to which the data are transferred
Dim FAR As Long 'First available row on AWS
Dim LR As Long 'Last row on the MWS sheets

Set AWS = ActiveSheet

For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS
Sheets("2007 - Golf Balls - USA").Select
Sheets("2007 - Golf Bags and Accessorie").Select

'-----Remove worksheets-----
Sheets(Array("2007 - Golf Balls - USA", "2007 - Golf Club Catalog - US", _
"2007 - Golf Club Catalog - USA ", "2007 - Golf Footwear - USA", _
"2007 - Golf Gloves - USA", "2007-Golf Apparel-SP-SU", _
"2007-Golf Apparel-Fall-Hol")).Select
Sheets("2007-Golf Apparel-Fall-Hol").Activate

Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
'---------------------------
Application.ScreenUpdating = True
MsgBox "The CDA data feed merge is complete! Use 'Save As' and select 'CSV (Comma Delimited)(.CSV)' as the file type to continue."
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Well I've one idea - remove every instance like this.:)
Code:
ActiveWindow.ScrollColumn = 1
Then post back with a little bit more information on what you actually want to do.

For example what are the criteria for deleting columns?
 
Upvote 0
Firstly, note that it is rarely necessary to select a range or even a worksheet for that matter to delete, insert or work with it. If you want to go more generic we will need some sort of idea of what conditions you have, how would you want it more generic things of that nature.

~Edit

Btw, when posting code it is very helpful to others if you post it with code tags.
Code:
[code]Post code
Here
[/code]
 
Upvote 0
Sorry about the posted code!...it was my first post!

After doing more research, I'm thinking that the macro code is just going to have to remain with specific sheets named.

The main problem is, the workbooks I am getting are an export from another tool. In which, the data is very inconsistent and could really change at any time. The columns in question can also change. All in all, there really isnt much "consistency" in the workbook to make it so I can eliminate alot of the named clutter.

...I know, I know....sometimes trying to get consistency is like pulling teeth! :unsure:
 
Upvote 0

Forum statistics

Threads
1,214,970
Messages
6,122,514
Members
449,088
Latest member
RandomExceller01

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