• 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.

Help with VBA Macro

H

hajduk1908

New Member
Hello

I have a macro to create a menu of all my worksheets in my workbook. I am given an option in the menu to select a worksheet, delete a certain number of rows then extract the remainer as CSV to my local computer. the problem is where the rows will vary for eg. On Worksheet name green I need to delete the first 11 rows and then extract the remaining information as a csv to my local computer. On it could be the first 40 rows and the remaining rows will need to be extracted to a csv. On Michael it could be the first 11 row etc etc. In the macro on select it will delete the first 10 rows and extract but how could I vary it for the detail I need ..thanks in advance
Thanks in advance

Code: 
Sub Test1()
Const ColItems  As Long = 15
Const LetterWidth As Long = 15
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"
Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": i = 0
  Application.ScreenUpdating = False
MsgBox "Have you saved this spreadsheet into a folder called APPY on your desktop?"
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 78: TopPos = 40
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1
If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16.5
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 10
End If
Next objSheet
If i > 0 Then
  .Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 2
  With .DialogFrame
  .Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 2)
  .Width = optLeft + (optMaxChars * LetterWidth) + 2
  .Caption = "Select the table(s) you want to export as a CSV?"
  End With
  .Buttons("Button 2").BringToFront
  .Buttons("Button 3").BringToFront
  If .Show = True Then
  For Each objOpt In wsDlg.OptionButtons
  If objOpt.Value = xlOn Then
  optCaption = objOpt.Caption
  Exit For
  End If
  Next objOpt
  End If
  If optCaption = "" Then
  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
  Sheets("Apple_Slots").Select
  Sheets("orange_Sub_Type").Select
  Sheets("tiger_Slots").Select
  Sheets("lion").Select
  Sheets("crab").Select
  Sheets("oliver").Select
  Sheets("michael").Select
  Sheets("lepod").Select
  Sheets("triangle").Select
  Sheets("screen").Select
  Sheets("mouse").Select
  Sheets("amle").Select
  Sheets("black").Select
  Sheets("blue").Select
  Sheets("green").Select
  Sheets("Identifier_1").Select
  Sheets("Invoice_5").Select
  Sheets("Location_screen").Select
  Sheets("Location_2").Select
  Sheets("Location_Type").Select
  Sheets("Locations").Select
  Sheets("Memo_Type").Select
  Sheets("frank_home").Select
  Sheets("Pink_5").Select
  Sheets("Pop_1").Select
  Sheets("Pay_6").Select
  Sheets("snake").Select
  Sheets("natural").Select
  Sheets("Port_5").Select
  Sheets("Provider_1").Select
  Sheets("Provider_2").Select
  Sheets("Patient_3").Select
  Sheets("Pat_5").Select
  Sheets("Ref_6").Select
  Sheets("Soccer forward").Select
  Sheets("Service_defender").Select
  Sheets("Soccer_back").Select
  Sheets("Title").Select
  Sheets("Transaction_Reason").Select
  Sheets("Waiver_1").Select
  Sheets("Assessment_5").Select
  Sheets("Electronic_Status").Select

  ws.Rows("1:11").Delete ' Delete 11 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

  Sheets("Michael_5").Select
  Sheets("Michael_6").Select
  Sheets("Michael-7").Select

  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

  Sheets("Provider_Payor_Link").Select

  ws.Rows("1:13").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

  Sheets("Sam_1").Select

  ws.Rows("1:28").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

  Sheets("Junirs).Select

  ws.Rows("1:40").Delete ' Delete 40 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

  Sheets("Defence").Select

  ws.Rows("1:51").Delete ' Delete 52 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


  Next ws



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

  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 Appy"



End Sub
 
Last edited by a moderator:
Just to give you a bit more information, it bring up the msg. have you saved the application in the correct folder then it gives you the menu with all the sheet names, when I select a sheet name it gives me a message stating that the csv already exist and then it seem to loop for a while, when I checked the csv it had the incorrect data for example opened up one csv and it had a few commas in it however I know I had data there.
 
Last edited:
You must log in or register to reply here.
Back
Top