Re-using existing sheets with macros 1

[Lhuffst]

I have an excel sheet that has 2 command buttons. 1 for input (ascii file) and 1 for export (back to ascii wtih updated data).

When I run the export, the last step seems to want to rename the spreadsheet and I lose my macros but I do not understand why. Here is the code I used.


ThisWorkbook.Sheets.Add after:=Sheet1
lrow = Sheet1.UsedRange.Rows.Count
Set r1 = Sheet1.Range(Cells(2, 1), Cells(lrow, 3))
Set r1 = Application.Union(r1, Range(Cells(2, 7), Cells(lrow, 9)))
Set r2 = Sheet1.Range(Cells(2, "K"), Cells(lrow, "K"))

'Concatanate the fields
Dim counter
For counter = 2 To lrow
Cells(counter, "K").Value = _
Cells(counter, 1).Value & Cells(counter, 2).Value & Cells(counter, 3).Value & _
Cells(counter, 7).Value & Cells(counter, 8).Value & Cells(counter, 9).Value
Next counter

'copy to new sheet
'r1.Copy (Sheets(Sheets.Count).[a1])
r2.Copy (Sheets(Sheets.Count).[a1])

'save the new sheet
Sheets(Sheets.Count).SaveAs Filename:="D:\My Data\FireHydrant Database\MainframeSide\testit.txt", FileFormat:=xlTextWindows

'delete the temporary sheet
Sheets(Sheets.Count).Delete

'close the text file
Close
'clear out the cells so it will be empty at the start
Sheet1.Range(Cells(1, "K"), Cells(lrow, "K")).ClearContents

any suggestions would be greatly appreciated.
lhuffst

 

[SkipVought]

You must add a new workbook to copy the r1 and r2 ranges into.

Save the NEW Workbook sheet, as .txt

Close the NEW workbook (it's already saved as a text file)

New you're back in the ORIGINAL workbook with your macros.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Lhuffst]

Thank you. That worked perfect. Unfortunately, the requirements that I recevied were a little short.
What really needs to happen is:

1. Import an ascii file that has been downloaded from mainframe into excel.
2. Send excel sheet to contractors who update the last 2 columns
3. Import the updated sheet back into the original excel sheet
4. export this updated sheet back to ascii for uploading to mainframe.

Steps 1 and 4 work fine and if I add a separate command button, then step 3 works fine
However, it would be better if I had only 2 buttons but am not sure what is the best way to proceed. This is what I have for code so far.

[b]
Private Sub CmdImport_Click()       STEP 1[/b]
'clear the last sheet
Inlrow = Sheet1.UsedRange.Rows.Count
Sheet1.Range(Cells(1, "K"), Cells(Inlrow, "K")).ClearContents
'read in the new data
 With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\My Data\FireHydrant Database\MainframeSide\PPCT.txt", Destination:= _
        Range("A1"))
        .Name = "PPCT"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


End Sub
[b]
Private Sub CmdUpdateImport_Click()     STEP 3[/b]
 Range("A1:I52").Select
    Selection.ClearContents
    Selection.QueryTable.Delete
    Range("A2").Select
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
      "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\My Data\FireHydrant Database\MainframeSide\FHP202NE08." _
        , _
        "xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Datab" _
        , _
        "ase Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global " _
        , _
        "Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;J" _
        , _
        "et OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        ), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("FHPAINT$")
        .Name = "FHP202NE08"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "D:\My Data\FireHydrant Database\MainframeSide\FHP202NE08.xls"
        .Refresh BackgroundQuery:=False
    End With
End Sub
[[b]
Private Sub CmdExport_Click()    STEP 4 [/b]'
' Exportit Macro
' Macro recorded 6/18/2008 by lhuffst

Dim wbNew As Workbook
Set wbNew = Workbooks.Add
'
ThisWorkbook.Sheets.Add after:=Sheet1
lrow = Sheet1.UsedRange.Rows.Count
Set r1 = Sheet1.Range(Cells(2, 1), Cells(lrow, 3))
Set r1 = Application.Union(r1, Range(Cells(2, 7), Cells(lrow, 9)))
Set r2 = Sheet1.Range(Cells(2, "K"), Cells(lrow, "K"))

'Concatanate the fields
Dim counter
For counter = 2 To lrow
        Cells(counter, "K").Value = _
        Cells(counter, 1).Value & Cells(counter, 2).Value & Cells(counter, 3).Value & _
        Cells(counter, 7).Value & Cells(counter, 8).Value & Cells(counter, 9).Value
Next counter

'copy to new sheet
'r1.Copy (Sheets(Sheets.Count).[a1])
'r2.Copy (Sheets(Sheets.Count).[a1])
r2.Copy wbNew.Sheets(1).[a1]
'save the new sheet
'Sheets(Sheets.Count).SaveAs Filename:="D:\My Data\FireHydrant Database\MainframeSide\testitNew.txt", FileFormat:=xlTextWindows
wbNew.Sheets(1).SaveAs Filename:="D:\My Data\FireHydrant Database\MainframeSide\testitToday.txt", FileFormat:=xlTextWindows
wbNew.Close
'delete the temporary sheet
Sheets(Sheets.Count).Delete

'close the text file
'Close
'clear out the cells so it will be empty at the start
Sheet1.Range(Cells(1, "K"), Cells(lrow, "K")).ClearContents

End Sub

 

[SkipVought]

Here's the rub.

You import a TEXT file into a sheet. How is this done? Are you using Data > Import External Data > Import File? I'd suggest that you do.

Here's why.

When you set up the Import, you have created a QueryTable on your sheet. Your QueryTable has a Connection property. You can CHANGE the Connection property to point to other data sources, like your returning workbook. That's basically all you have to do.

Play around with the understanding the QT, using this code...

Sub test()
    Dim qt As QueryTable, lRow As Long
    lRow = 1
    For Each qt In Sheet1.QueryTables
        Debug.Print qt.Name
        Debug.Print qt.Connection
        Debug.Print qt.Destination.Address
        Debug.Print qt.QueryType
        Debug.Print lRow
        lRow = lRow + 1
    Next
End Sub

I'd suggest doing an IMPORT or the workbook manually and then looking at the properties. That way you can know how to manipulate the Connection property. Pay attention to the PARSING properties.

You can also turn on your macro recorder and record EDITING the QT, eithout actually changing anything. Then observe your code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Lhuffst]

I've used the macro recording and modified the code to allow users to select which excel file they want. Everything runs fine except that the .refresh doesn't work for me. I get a popup box that has the datasource information and which you click ok, then you get an object error.

If I run it without this step, then I get a blank sheet and when I right click and say refresh, the data shows up. What am I doing wrong?

Private Sub CmdImportVendor_Click()
Dim fopen As Variant
lrow = Sheet1.UsedRange.Rows.Count
Sheet1.Range(Cells(1, "a"), Cells(lrow, "k")).ClearContents
fopen = Application.GetOpenFilename("ExcelSheets (*.xls),*.xls")
'Dim wbNew As Workbook
'Set wbNew = Workbooks.Add


'
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\My Data\FireHydrant Database\MainframeSide\" & fopen & ".xls" _
        , _
        "xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Datab" _
        , _
        "ase Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global " _
        , _
        "Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;J" _
        , _
        "et OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        ), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("FHPAINT$")
        .Name = fopen
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = True
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "D:\My Data\FireHydrant Database\MainframeSide\" & fopen & ".xls"
        .Refresh BackgroundQuery:=True
        
        
    End With

End Sub

thanks for all the help. This has been a real challenge for me but with your help, I have begun to understand how the macros are working.
lhuffst

 

[PHV]

what about this ?

Private Sub CmdImportVendor_Click()
Dim fopen As Variant, strFile As String, lrow As Long
lrow = Sheet1.UsedRange.Rows.Count
Sheet1.Range(Cells(1, "a"), Cells(lrow, "k")).ClearContents
fopen = Application.GetOpenFilename("ExcelSheets (*.xls),*.xls")
If fopen = False Then
  Exit Sub
End If
strFile = Replace(Dir(fopen), ".xls", "", , , vbTextCompare)
With Sheet1.QueryTables.Add(Connection:= _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & fopen & _
        ";Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Datab" & _
        "ase Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global " & _
        "Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;J" & _
        "et OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        , Destination:=Range("A1"))
    .CommandType = xlCmdTable
    .CommandText = Array("FHPAINT$")
    .Name = strFile
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = True
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = fopen
    .Refresh BackgroundQuery:=True
End With
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SkipVought]

"...when I right click and say refresh, the data shows up. "

The QueryTable is ALREADY THERE (hence the Refresh)

Why are you ADDING a new QT??? You select the file they want and then MODIFY the EXISTING QT Connection property accordingly and then REFRESH the EXISTING QT.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}