Hi,
I have the following code in an Excel workbook for MS Office/Windows XP.
I need to change it to run on a Mac. Can someone tell me what changes I need to make to the code to get it to run, or point me in the direction of an answer. Basically, I need to allow the user to browse to and open a file and I also need to clear out the contents of the current sheet.
Code:
Sub Openimportfile()
On Error GoTo import_err
fname = Application.GetOpenFilename("Excel Files (*.xls), *.xls", , "Select a File to Import")
If fname <> False Then
Set mybook = Workbooks.Open(Filename:=fname)
Set r = mybook.Worksheets(1).Columns("A").Cells
For Each c In r.Cells
'grab title
If Left(c.Value, 5) = "TI -" Then
strTitle = Trim(Right(c.Value, Len(c.Value) - 5))
Set nextCell = c.Offset(1, 0)
Do While Mid(nextCell.Value, 5, 1) <> "-"
strTitle = strTitle & " " & Trim(nextCell.Value)
Set nextCell = nextCell.Offset(1, 0)
Loop
If Right(strTitle, 1) = "." Then strTitle = Left(strTitle, Len(strTitle) - 1)
If strTitle = "" Then strTitle = "N/A"
Set rTitle = ThisWorkbook.Worksheets(1).Columns("A").Cells
For Each ctitle In rTitle.Cells
If ctitle.Value = "" Then
currRow = ctitle.Row
ctitle.Value = strTitle
Exit For
End If
Next
End If
'grab Address
If Left(c.Value, 5) = "AD -" Then
strAddress = Trim(Right(c.Value, Len(c.Value) - 5))
Set nextADCell = c.Offset(1, 0)
Do While Mid(nextADCell.Value, 5, 1) <> "-"
strAddress = strAddress & " " & Trim(nextADCell.Value)
Set nextADCell = nextADCell.Offset(1, 0)
Loop
'grab email
lemail = InStr(strAddress, "@")
If lemail > 0 Then
lemail = lemail - 1
For i = lemail To 1 Step -1
If Mid(strAddress, i, 1) = " " Then Exit For
strEmail = Right(strAddress, Len(strAddress) - (i - 1))
Next
strAddress = Left(strAddress, Len(strAddress) - Len(strEmail))
End If
strRange = "B" & ctitle.Row
Set raddress = ThisWorkbook.Worksheets(1).Range(strRange)
raddress.Value = strAddress
strRange = "C" & ctitle.Row
Set rEmail = ThisWorkbook.Worksheets(1).Range(strRange)
rEmail.Value = strEmail
End If
'grab Name
If Left(c.Value, 5) = "FAU -" Then
Set prevCell = c.Offset(-1, 0)
If (Left(prevCell.Value, 5) <> "FAU -" And Left(prevCell.Value, 5) <> "AU -") Then
strname = Trim(Right(c.Value, Len(c.Value) - 5))
strFirstName = Right(strname, Len(strname) - InStr(strname, ","))
strLastName = Left(strname, InStr(strname, ",") - 1)
strRangeFirst = "D" & ctitle.Row
strRangeLast = "E" & ctitle.Row
Set rFirstName = ThisWorkbook.Worksheets(1).Range(strRangeFirst)
Set rLastName = ThisWorkbook.Worksheets(1).Range(strRangeLast)
rFirstName.Value = Trim(strFirstName)
rLastName.Value = Trim(strLastName)
End If
End If
'grab Journal
If Left(c.Value, 5) = "TA -" Then
strJournal = Trim(Right(c.Value, Len(c.Value) - 5))
strRange = "F" & ctitle.Row
Set rJournal = ThisWorkbook.Worksheets(1).Range(strRange)
rJournal.Value = strJournal
End If
strTitle = ""
strFirstName = ""
strLastName = ""
strAddress = ""
strEmail = ""
strJournal = ""
Next
mybook.Close
ActiveWorkbook.Save
MsgBox "Import Complete."
End If
Exit Sub
import_err:
MsgBox Err.Description
Exit Sub
End Sub
Public Sub ClearData()
On Error GoTo ClearData_err
Cells.Select
Selection.ClearContents
ThisWorkbook.Worksheets(1).Range("A1").Value = "Title"
ThisWorkbook.Worksheets(1).Range("B1").Value = "Address"
ThisWorkbook.Worksheets(1).Range("C1").Value = "Email"
ThisWorkbook.Worksheets(1).Range("D1").Value = "First Name"
ThisWorkbook.Worksheets(1).Range("E1").Value = "Last Name"
ThisWorkbook.Worksheets(1).Range("F1").Value = "Journal"
ActiveWorkbook.Save
Exit Sub
ClearData_err:
MsgBox Err.Description
Exit Sub
End Sub
