Need to export selected data from Excel.

Is rowA set up as such:

col rowA      rowB
1: Acct3323   1000
2: Acct1122   2000
3:
4: Acct3112   4000
etc.

I need to know what constitutes an "Account Number" in rowA. If it is not blank, then it is an account number. If it is preceeded with Acct, then it is an account number.

Each cell in Column A is either blank, or has alpha characters, or has a number formatted as:
00 0000 000. I only care about the latter.

In a macro, sort your data.
Cut the out the data you want and paste it to another sheet.
Then export it.

Hi ksander, below is some code doing this

- Just bring up the VBA editor with ALT+F11
- Insert a new module
- Paste this code
- Call the sub AccountExport
- It can be modified to your needs

the exported data will begin on line 2, you can change this with je j parameter in the sub AccountExport

'-----start code------

Option Explicit

Sub AccountExport()
   
Dim strDataSheet As String, strAccumSheet As String
Dim lngNumberOfRecords As Long, i As Long, j As Long
 
On Error GoTo Errhandle
 
  'get number of records or jump out on worng input
 
  strDataSheet = InputBox("Please give the name of the raw data sheet ")
  strAccumSheet = InputBox("Please give the name of the new data sheet for export")
 
  lngNumberOfRecords = InputBox("Number of records to process")
  If Not IsNumeric(lngNumberOfRecords) Then Exit Sub
 
  j = 2

  Sheets(strDataSheet).Select
  Sheets.Add
  Sheets.Select
  ActiveSheet.Name = strAccumSheet
  Sheets(strDataSheet).Select
  For i = 2 To lngNumberOfRecords
    Range("A" & i).Select
    If fctValidateAccNumber(Selection) Then
      Range("A" & i & ":O" & i).Copy
      Sheets(strAccumSheet).Select
      Range("A" & j).Select
      ActiveSheet.Paste
      j = j + 1
      Sheets(strDataSheet).Select
    End If
    Next i
  If Not fctExportToFile(strAccumSheet) Then MsgBox "File not saved"
  Exit Sub
Errhandle:
  MsgBox "An error has occurred " & Err.Description
  Exit Sub
End Sub

Function fctValidateAccNumber(ByVal strAccount As String) As Boolean
Dim strAccPart As String

On Error GoTo Errhandle

  fctValidateAccNumber = False
  strAccPart = Right(strAccount, 2)
  If IsNumeric(strAccPart) Then
    strAccPart = Mid(strAccount, 4, 4)
    If IsNumeric(strAccPart) Then
      strAccPart = Left(strAccount, 3)
      If IsNumeric(strAccPart) Then fctValidateAccNumber = True
    End If
  End If

Exit Function
Errhandle:
  MsgBox "An error has occurred " & Err.Description
  Exit Function

End Function

Function fctExportToFile(ByVal strSheet As String) As Boolean
Dim strFileName As String

On Error GoTo Errhandle

fctExportToFile = False
strFileName = InputBox("Please give filename + path like, C:\My Documents\Map1.csv ")
  Sheets(strSheet).Select
  ActiveWorkbook.SaveAs Filename:=strFileName, FileFormat:= _
        xlCSV, CreateBackup:=False
  fctExportToFile = True
Exit Function
Errhandle:
  MsgBox "An error has occurred " & Err.Description
  Exit Function

End Function

'-----end code------

HTH:O)Bruintje

I did the above with the following results:

It did select the rows with account numbers from the Data sheet and copied them to the Accum sheet - but I can't tell exactly what happened.  It's copying the formulas or references in B:0. I need the Values.

It added a sheet (Sheet 2).

I gave it Output.csv as strFileName. It renamed the Accum sheet to Output. It seemed to rename the workbook to Output.csv. I want the workbook to stay as it was, except for populating the Accum sheet, and the strFileName to be written to disk.  


Any ideas ?

 

 

Edit->Copy
(go to new reference)
Edit-Paste Special->Values

Triskelion - I don't know how to modify Bruintje's macro to do that

i should use a disclaimer for this

first restore your original workbook
- just throw away the second worksheet
- then rename the workbook to it's original name
- all right make a copy of this workbook
- now we can go on with the code

what Triskelion said about the paste is true

i'll add a line for that in the code above

'-----start code------

Sub AccountExport()
   
Dim strDataSheet As String, strAccumSheet As String, strWorkBookName As String
Dim lngNumberOfRecords As Long, i As Long, j As Long

On Error GoTo Errhandle
 
 'get number of records or jump out on worng input
 strWorkBookName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
 strDataSheet = InputBox("Please give the name of the raw data sheet ")
 strAccumSheet = InputBox("Please give the name of the new data sheet for export")
 
 lngNumberOfRecords = InputBox("Number of records to process")
 If Not IsNumeric(lngNumberOfRecords) Then Exit Sub
 
 j = 2

 Sheets(strDataSheet).Select
 Sheets.Add
 Sheets.Select
 ActiveSheet.Name = strAccumSheet
 Sheets(strDataSheet).Select
 For i = 2 To lngNumberOfRecords
   Range("A" & i).Select
   If fctValidateAccNumber(Selection) Then
     Range("A" & i & ":O" & i).Copy
     Sheets(strAccumSheet).Select
     Range("A" & j).Select
     ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
     j = j + 1
     Sheets(strDataSheet).Select
   End If
   Next i
 If Not fctExportToFile(strAccumSheet) Then MsgBox "File not exported"
 If Not fctReturnToOriginal(strWorkBookName, strAccumSheet) Then MsgBox "Error while returning to original"
 Exit Sub
Errhandle:
 MsgBox "An error has occurred " & Err.Description
 Exit Sub
End Sub

Function fctValidateAccNumber(ByVal strAccount As String) As Boolean
Dim strAccPart As String

On Error GoTo Errhandle

 fctValidateAccNumber = False
 strAccPart = Right(strAccount, 2)
 If IsNumeric(strAccPart) Then
   strAccPart = Mid(strAccount, 4, 4)
   If IsNumeric(strAccPart) Then
     strAccPart = Left(strAccount, 3)
     If IsNumeric(strAccPart) Then fctValidateAccNumber = True
   End If
 End If

Exit Function
Errhandle:
 MsgBox "An error has occurred " & Err.Description
 Exit Function

End Function

Function fctExportToFile(ByVal strSheet As String) As Boolean
Dim strFileName As String

On Error GoTo Errhandle

fctExportToFile = False
strFileName = InputBox("Please give filename + path like, C:\My Documents\Map1.csv ")
 Sheets(strSheet).Select
 ActiveWorkbook.SaveAs Filename:=strFileName, FileFormat:= _
       xlCSV, CreateBackup:=False
 fctExportToFile = True
Exit Function
Errhandle:
 MsgBox "An error has occurred " & Err.Description
 Exit Function

End Function

Function fctReturnToOriginal(ByVal strWorkBook As String, _
                          ByVal strAccuSheet As String)
On Error GoTo Errhandle
   
fctReturnToOriginal = False
   
    ActiveWorkbook.SaveAs Filename:=strWorkBook, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    Sheets(strAccuSheet).Select
    ActiveWindow.SelectedSheets.Delete
    fctReturnToOriginal = True
Exit Function
Errhandle:
 MsgBox "An error has occurred " & Err.Description
 Exit Function

End Function

'-----end code------

the last function is added for saving the original workbook and throwing out the exported sheet

HTH:O)Bruintje

I haven't been able to get it to work.

1) If I use the name of an existing sheet for "strAccumSheet" and that sheet is the last in the workbook, I get "Cannot rename a sheet to the same name as another sheet" message.

2) If an existing sheet is the first sheet, the message is
"An error has occurred Application-defined error or object-defined error"

In both cases it creates a blank sheet named Sheet(n).

3) If the sheet doesn't exist, it renames my first sheet.

Ideally it should check for the existance of the sheet wherever it's located, use it if it finds it or create it (as the last sheet) if it doesn't  

in my comment above it must read
it checks if your sheet exists, if so it will use it else it will create a new one

I'm past the above errors. I changed:
-------------------------------------
Sheets(strDataSheet).Select
Sheets.Add
Sheets.Select
ActiveSheet.Name = strAccumSheet
Sheets(strDataSheet).Select
For i = 2 To lngNumberOfRecords
  Range("A" & i).Select
  If fctValidateAccNumber(Selection) Then
    Range("A" & i & ":O" & i).Copy
    Sheets(strAccumSheet).Select
    Range("A" & j).Select
    ActiveSheet.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= False, Transpose:=False
    j = j + 1
    Sheets(strDataSheet).Select
  End If
  Next i
---------------------------------------------------
to:
---------------------------------------------------
Sheets(strDataSheet).Select
For i = 8 To lngNumberOfRecords
  Range("A" & i).Select
  If fctValidateAccNumber(Selection) Then
    Range("A" & i & ":O" & i).Copy
    Sheets(strAccumSheet).Select
    Range("A" & j).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= alse, Transpose:=False
    j = j + 1
    Sheets(strDataSheet).Select
  End If
Next i
-----------------------------------------
And, with the strAccumSheet already existing, the copying works fine without the other problems.

The rest isn't so good. There has got to be a better way to export a worksheet (or just a range on a worksheet) than one that involves changing the name of the workbook to (filename).csv then attempting to rename back to the original. (The rename-by-Save-as errors out saying attempting to save in an unsupported format.)

Isn't there a way to export (if that's the term) just a portion of a sheet without changing the whole workbook ?

we cross-posted.....

Your latest fixes the strAccumSheet problem. Any ideas on the other?

Hi ksander, read the export part on this page, guess chip pearson has something to offer here :O)

http://www.cpearson.com/excel/imptext.htm#Import

HTH:O)Bruintje

Your answer did the trick.  I couldn't find a solution for the second part but did develop a workaround.

Thanks very much for your help

you're welcome