Stripping Extra Characters?

[james.igoe]

I have spreadsheet VBA that does the following in another spreadsheet:

* User selects CSV
* Files is transferred to an array (1 column), before parsing
* Files is imported, parsed and formatted on tab 1
* Array is searched for user-defined strings, keeping rows
* Array is then imported, parsed and formatted on tab 2
* Pivot table is created and formatted on tab 3 from tab 2
* Tab 2 worksheet is rearranged on tab 4, column by column, e.g. the
originating spreadsheet tells it which columns should go in which
order

The last stage is the problem area. The order of columns is defined by
the macro, but because the copying fails on some cells. Initially, the
code rearranged the spreadsheet cells by cell, but some very long,
multi-rowed cells, where a user has inserted Alt+Enter, were copied
with # value instead of the real value. I am unable to get my code to
copy whole columns. I have also tried to strip out what are linefeeds,
but causes problems in other cells.

 

[james.igoe]

This is a portion of the code, the lines that copy one range to
another. The numbers match up, using the used range of the data sheet
to define the range of the target:

Private Function ReorderColumns(objExcelWorksheetData As Worksheet,
objExcelWorksheetTarget As Worksheet) As Boolean

Dim dLastColumn As Double
Dim dLastRow As Double
Dim aPatternList As Variant

Dim dRow As Double
Dim dColumn As Double

Dim dRowWrite As Double
Dim dLastRowWrite As Double

Dim strNewValue As String

With Workbooks("ATSSearcher.xls").Worksheets("Output Fields, Order, &
Format")
dLastRow = .UsedRange.Rows.count
aPatternList = .UsedRange
End With

With objExcelWorksheetData
dLastRowWrite = .UsedRange.Rows.count
dLastColumn = .UsedRange.Columns.count
End With

On Error GoTo ErrorTrap

'Begins loop to match field names and reorder them
For dRow = 2 To dLastRow

With objExcelWorksheetData

dColumn = 1

While dColumn <= dLastColumn

If objExcelWorksheetData.Cells(1, dColumn) =
aPatternList(dRow, 1) Then

For dRowWrite = 1 To dLastRowWrite

'Copies ranges
objExcelWorksheetTarget.Range(Cells(dRowWrite,
aPatternList(dRow, 2)), Cells(dLastRowWrite, aPatternList(dRow, 2))) _
=
objExcelWorksheetData.Range(Cells(dRowWrite, dColumn),
Cells(dLastRowWrite, dColumn))

Next

Select Case aPatternList(dRow, 3)
Case "Text"

objExcelWorksheetTarget.Columns(aPatternList(dRow, 2)).NumberFormat =
"General"
Case "Date"

objExcelWorksheetTarget.Columns(aPatternList(dRow, 2)).NumberFormat =
"mm/dd/yyyy"
Case Else

objExcelWorksheetTarget.Columns(aPatternList(dRow, 2)).NumberFormat =
"General"
End Select

End If

dColumn = dColumn + 1

Wend

End With

Next dRow

ReorderColumns = True

Exit Function

ErrorTrap:

Application.Cursor = xlDefault

MsgBox Err.Description

ReorderColumns = False

End Function

 

[james.igoe]

No need to answer. I used a copy fnction avoiding this issue, but it
was confounding as a I could not ciopy range to range, but had to copy
range to cells.