|
-
Oct 1st, 2000, 10:54 PM
#1
Private Sub btnRun_Click()
On Error GoTo Err_btnRun
Dim objXLApp As Object
Dim Rng As Range
Dim LastRow As Integer
Dim LastColumn As Integer
Dim MP3Collection As String
Dim WishList As String
Screen.MousePointer = vbHourglass
' Launch Microsoft Excel
Set objXLApp = CreateObject("Excel.Application")
objXLApp.Visible = False
Application.ScreenUpdating = False
'Open MP3 Collection List
MP3Collection = txtWishList(1).Text
Workbooks.Open filename:=MP3Collection
' Temporarily Delete Column 3
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
'Finds the first empty cell in the last row & column
Range("A1").Select
LastRow = Selection.End(xlDown).Offset(0, 0).Select
LastColumn = Selection.End(xlToRight).Offset(0, 1).Select
ActiveCell.Name = "Finish"
' Create concatenate formula
ActiveCell.FormulaR1C1 = "=RC[-2]&"" ""&""-"" &"" ""&RC[-1]"
'Fill in column "C" with the DiscNum variable
Worksheets("Mp3_Export").Range("C2:Finish").FillUp '*********
'Open Wish List
WishList = txtWishList(0).Text
Workbooks.Open filename:=WishList
' Sort the data
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
'Trim the white space before the song titles
For Each Rng In Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns("A:B")).SpecialCells(xlCellTypeConstants, xlTextValues)
Rng.Value = Trim(Rng.Value)
Next Rng
'Finds the first empty cell in the last row & column
Range("A1").Select
LastRow = Selection.End(xlDown).Offset(0, 0).Select
LastColumn = Selection.End(xlToRight).Offset(0, 1).Select
ActiveCell.Name = "Finish"
' Create concatenate formula
ActiveCell.FormulaR1C1 = "=RC[-2]&"" ""&""-"" &"" ""&RC[-1]"
'Fill in column "C" with the DiscNum variable
Worksheets("Sheet1").Range("D2:Finish").FillUp '********
'Finds the first empty cell in the last row & column
Range("A1").Select
LastRow = Selection.End(xlDown).Offset(0, 0).Select
LastColumn = Selection.End(xlToRight).Offset(0, 1).Select
ActiveCell.Name = "Last"
ActiveCell.FormulaR1C1 = "=COUNTIF([Collection.xls]Mp3_Export!C[-1],RC[-1])" '********
'Fill in column "C" with the DiscNum variable
Worksheets("Sheet1").Range("D2:Last").FillUp '********
'Delete Duplicates
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:=">0", Operator:=xlAnd
Range("A1").Select
LastRow = Selection.End(xlDown).Offset(0, 0).Select
LastColumn = Selection.End(xlToRight).Offset(0, 0).Select
ActiveCell.Name = "Finish"
Range("A2:Finish").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.AutoFilter
' Delete Temporary Data
Columns("C ").Select
Selection.Delete Shift:=xlToLeft
' Sort the data
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
'Save & Close Wish List
ActiveWorkbook.Save
ActiveWorkbook.Close
ActiveWorkbook.Saved = True
'Close Excel
Application.Quit
Set objXLApp = Nothing
Screen.MousePointer = vbDefault
Unload Me
Exit_btnRun:
Exit Sub
Err_btnRun:
MsgBox Err.Number & " " & Err.Description
Resume Exit_btnRun
End Sub
TIA
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|