• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to perferm mutiple functions dependent on worksheet selected

D

Dinamo

New Member
Good Afternoon/Morning

I need to produce a menu in a excel workbook to give users the ability to select a worksheet and run a macro, depending on which worksheet they select the macro it needs to delete a number of rows
and save off the remaining data as a csv file on the local computer, if you look below if the users select "providers" it will delete the top 40 rows and save it off as a csv with providers.csv as the name, if the user selects Provider Payor link it will delete the top 13 row and save it as as csv as Provider Payor Link.csv,
The purpose of all of this is to import the data into another application. If it is not

Payment Method; "Waiver Source"; "Waiver Type"
"Providers"
"Provider Payor link"
"Service Code"
"source"

it will need to delete the standard 11 rows and save the remaining data to as CSV unless its worksheet name "Clean CSV" or "document" it will do nothing. The user will need the ability to select more than one worksheet to export, maybe to use check boxes.
Below is a snippet of the macro and I can get it to to delete a standard number of rows but I have problems when I the number differs. I have included an example file, had to trim it down but it will give you an example....any help will be appreciated as I am new to this


Code: 
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
Application.ScreenUpdating = True
Exit Sub
Else
'MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate

For Each ws In ActiveWindow.SelectedSheets

If ws= "Payment Method"; "Waiver Source"; "Waiver Type"
ws.Rows("1:12").Delete ' Delete 12 rows at top of each sheet.
ws.Copy
Range("A1").Interior.Color = 1 ' Format A1 so the top rows are included in the used range and saved
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges = False
MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"


If ws= "Providers"
ws.Rows("1:40").Delete ' Delete 40 rows at top of this sheet.
ws.Copy
Range("A1").Interior.Color = 1 ' Format A1 so the top rows are included in the used range and saved
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges = False
MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"


If ws= "Provider Payor link"
ws.Rows("1:13").Delete ' Delete 13 rows at top of each sheet.
ws.Copy
Range("A1").Interior.Color = 1 ' Format A1 so the top rows are included in the used range and saved
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges = False
MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"



If ws= "Service Code"
ws.Rows("1:51").Delete ' Delete 51 rows at top of each sheet.
ws.Copy
Range("A1").Interior.Color = 1 ' Format A1 so the top rows are included in the used range and saved
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges = False
MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"



If source="Source"
ws.Rows("1:20").Delete ' Delete 28 rows at top of each sheet.
ws.Copy
Range("A1").Interior.Color = 1 ' Format A1 so the top rows are included in the used range and saved
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges = False
MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"


Else
If source <> "Clean CSV";"Document_control" then
MsgBox ("You cant extract this sheet"), please attempt another sheet


Next ws


ws.Rows("1:11").Delete ' Delete 10 rows at top of each sheet.
ws.Copy
Range("A1").Interior.Color = 1 ' Format A1 so the top rows are included in the used range and saved
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges = False
MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"




Next ws



strFormWS = optCaption
End If
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True





End Sub
 

Attachments

Last edited by a moderator:
Perhaps something like this:

Code: 
    For Each ws In ActiveWindow.SelectedSheets
        Select Case ws.Name
            Case "Payment Method", "Waiver Source", "Waiver Type"
                ws.Rows("1:12").Delete    ' Delete 12 rows at top of each sheet.
            Case "Providers"
                ws.Rows("1:40").Delete    ' Delete 40 rows at top of this sheet.
            Case "Provider Payor link"
                ws.Rows("1:13").Delete
            Case "Service Code"
                ws.Rows("1:51").Delete
            Case "Source"
                ws.Rows("1:20").Delete
            Case "Clean CSV", "Document_control"
                Exit Sub
            Case Else
                ws.Rows("1:11").Delete    ' Delete 10 rows at top of each sheet.
        End Select
        ws.Copy
        Range("A1").Interior.Color = 1    ' Format A1 so the top rows are included in the used range and saved
        ActiveWorkbook.SaveAs Filename:=Path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges = False
        MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
        MsgBox "If you have problems importing run the CleanCSV function and retry inport into dodo"

    Next ws
 
Thanks Debaser

However the macro is still working on the worksheet its been run from, if I run the menu from the worksheet called index it will attempt to delete the top ten lines from index rather than Address Slots which is a worksheet I selected. Tried fixing it and using t the example Address Slots but got a compile error.

Any ideas?

sippet

Code: 
End Select

  ws.Copy

  Range("A1").Interior.Color = 1  ' Format A1 so the top rows are included in the used range and saved
  Case "Address Slots".SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
  ActiveWorkbook.Close SaveChanges:=False

Mod Edit:
Please tag codes correctly.
 
Last edited by a moderator:
You must log in or register to reply here.
Back
Top