trying to run this code through customized ribbon and place it in module

shayanhaque

New Member
Joined
Mar 13, 2019
Messages
19
HI,
I'm trying to run the following code from customized ribbon and wants to run this code for all sheets but when i do that it just skips the second case and exits the program. Can you please assist how can i make this to run in module for all sheets. I'm fairly new to VB and i really appreciate your help.

Sub test()
Dim Ary As Variant
Dim NewBk As Workbook
Dim ws As Worksheet
Dim Pth As String

With Application.fileDialog(4)
If .Show = -1 Then Pth = .SelectedItems(1)
End With
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Sheet1", "Error log", "JUMPER REPORT", "WIRE LABELS", "TERMINATION COUNT"
Case Else
Ary = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)).Value2
ws.Range("V1").Resize(UBound(Ary)).Value = Ary
Set NewBk = Workbooks.Add
NewBk.Sheets(1).Range("A1").Resize(UBound(Ary)).Value = Ary
NewBk.SaveAs FileName:=Pth & "" & ws.Name & ".csv", FileFormat:=xlCSV

NewBk.Close False
Set Ary = Nothing
Set NewBk = Nothing
End Select
Next ws
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
It is working well, just one minor detail: Pth must end with a \, otherwise your files get misplaced and incorrectly named:
Code:
Sub test()
Dim Ary As Variant
Dim NewBk As Workbook
Dim ws As Worksheet
Dim Pth As String


With Application.fileDialog(4)
If .Show = -1 Then Pth = .SelectedItems(1)
[COLOR=#ff0000]if len(pth)=0 then Exit sub
if right(pth,1)<>"\" then pth=pth& "\"[/COLOR]
End With
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Sheet1", "Error log", "JUMPER REPORT", "WIRE LABELS", "TERMINATION COUNT"
Case Else
Ary = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)).Value2
ws.Range("V1").Resize(UBound(Ary)).Value = Ary
Set NewBk = Workbooks.Add
NewBk.Sheets(1).Range("A1").Resize(UBound(Ary)).Value = Ary
NewBk.SaveAs FileName:=Pth & "" & ws.Name & ".csv", FileFormat:=xlCSV


NewBk.Close False
Set Ary = Nothing
Set NewBk = Nothing
End Select
Next ws
End Sub
It is correctly looping through all sheets, skipping the ones, mentioned in Case 1, creating the new wbk and savig as CSV. All works.
Maybe you should add some error handling.
 
Upvote 0
It works fine if i place this in " Thisworkbook" but i want to run it in module and attach it to customized button so that whenever we select that it runs this code for all sheets regardless of workbook and number of sheets. Please assist. Thank you
 
Upvote 0
Well, this is slightly different case.
The way you wrote it works flawlessly in the workbook where the code resides. However if you want to run it on workbooks that don't have the code in them you have to:
- put the code in a standard module in a workbook. Save the workbook as personal.xlsb or as addin and place them in the necessary location (folder) (google the subject.
- add a button to the ribbon which calls the macro
- Necessary changes in the code to make it work on the currently active workbook:
Code:
Sub test()
Dim Ary As Variant
Dim NewBk As Workbook[COLOR=#0000ff], awb As Workbook[/COLOR]


Dim ws As Worksheet
Dim Pth As String

With Application.fileDialog(4)
If .Show = -1 Then Pth = .SelectedItems(1)
if len(pth)=0 then Exit sub
if right(pth,1)<>"\" then pth=pth& "\"
End With

[COLOR=#0000ff]set awb = Activeworkbook[/COLOR]

For Each ws In [COLOR=#0000ff]awb[/COLOR].Worksheets
Select Case ws.Name
Case "Sheet1", "Error log", "JUMPER REPORT", "WIRE LABELS", "TERMINATION COUNT"
Case Else
Ary = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)).Value2
ws.Range("V1").Resize(UBound(Ary)).Value = Ary
Set NewBk = Workbooks.Add
NewBk.Sheets(1).Range("A1").Resize(UBound(Ary)).Value = Ary
NewBk.SaveAs FileName:=Pth & "" & ws.Name & ".csv", FileFormat:=xlCSV

NewBk.Close False
Set Ary = Nothing
Set NewBk = Nothing
End Select
Next ws
End Sub
 
Last edited:
Upvote 0
glad i could help
but i am afraid i do not understand this last question
CSV is comma separated values, a simple text file. do you want to prepare it for printing from text?
 
Upvote 0
what i'm trying to do is when we add a new work book and store array data in first column, i want to center align all of the data because in new sheet some of the data is left aligned and some is right aligned because once i open the saved csv file i can center align it using align command on toolbar but i want to do that using vba.
 
Upvote 0
You can't save alignment in csv.
What you can do is align the data after importing like this:
Code:
Columns("A:A").HorizontalAlignment = xlCenter
 
Upvote 0
it means once all files are done, i have to open them and align them one by one. is there a fast way to do that? I mean using vba open those files from same location regardless of names and do this process please?
 
Upvote 0
Sorry I got lost. Maybe start a different post and try to explain clearly what exactly you need.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,040
Members
448,543
Latest member
MartinLarkin

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