waterdog15
New Member
- Joined
- Dec 27, 2009
- Messages
- 15
I am retrieving data from word tables and on some of the cells, excel is dropping the hyphen. For example, in word, the data cell is:
In Excel the data becomes:
MCC654A M1332 (Drive Room) MLP
It doesn't do it on everything. Any ideas? Below is the code I have put together with the help of this board and its contributors!
Thank-you,
Paul
Private Sub CommandButton1_Click()
'Import all tables to separate sheets
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim Pointer As Long 'row tabulator from mr excel
Dim Supervisor As Variant 'lock out supervisor
Dim LOreason As Variant ' reason for lock-out
Dim LOdate As Variant ' date of lock-out
Dim Only1Header
Supervisor = Range("c4").Text
LOreason = Range("c5").Text
LOdate = Range("c6").Text
Only1Header = 1
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
If wdDoc.tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
Sheets.Add after:=Sheets(Worksheets.Count)
Pointer = 0
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = Only1Header To .Rows.Count
Pointer = Pointer + 1
For iCol = 1 To 3
On Error Resume Next
ActiveSheet.Cells(Pointer, iCol + 1) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
ActiveSheet.Cells(Pointer, iCol + 2) = Supervisor
ActiveSheet.Cells(Pointer, 1) = LOreason
ActiveSheet.Cells(Pointer, iCol + 3) = LOdate
Next iRow
End With
Only1Header = 3
Next TableNo
End If
End With
ActiveSheet.Columns.AutoFit
Set wdDoc = Nothing
End Sub
MCC‑65‑4A M‑1332 ( Drive
Room) MLP
In Excel the data becomes:
MCC654A M1332 (Drive Room) MLP
It doesn't do it on everything. Any ideas? Below is the code I have put together with the help of this board and its contributors!
Thank-you,
Paul
Private Sub CommandButton1_Click()
'Import all tables to separate sheets
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim Pointer As Long 'row tabulator from mr excel
Dim Supervisor As Variant 'lock out supervisor
Dim LOreason As Variant ' reason for lock-out
Dim LOdate As Variant ' date of lock-out
Dim Only1Header
Supervisor = Range("c4").Text
LOreason = Range("c5").Text
LOdate = Range("c6").Text
Only1Header = 1
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
If wdDoc.tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
Sheets.Add after:=Sheets(Worksheets.Count)
Pointer = 0
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = Only1Header To .Rows.Count
Pointer = Pointer + 1
For iCol = 1 To 3
On Error Resume Next
ActiveSheet.Cells(Pointer, iCol + 1) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
ActiveSheet.Cells(Pointer, iCol + 2) = Supervisor
ActiveSheet.Cells(Pointer, 1) = LOreason
ActiveSheet.Cells(Pointer, iCol + 3) = LOdate
Next iRow
End With
Only1Header = 3
Next TableNo
End If
End With
ActiveSheet.Columns.AutoFit
Set wdDoc = Nothing
End Sub