Simon,

The code falls down at this line;
clnWrkSht.Cells(i + 1, clnHeadingCntr) = ithRange.Cells(1, k)

My Objective: (Excel 2003)
I have a workbook that is an export from a database, on this file one record
could have multiple values to a column, visually one record could have
multiple rows, due to multiple values in a field in the dtabase form, with
this macro it places the record into one row and determines if I need
multiple columns or the field info placed into one column. Hope this makes
sense.

Example: State column, could have three states I indicate I want three
columns instead of the three states in one cell.


With the code below I have a worksheet titled "Settings" that I indicate the
column headings, whether or not I want to extract the column, if it has
multiple value, if free form allowed and the possible Values, if mutiple.
I select a macro button , titled "Transform" , when doing this the macro
opens the workbook( based on the location indicated in a cell on the
"Settings" worksheet ) and starts placing the data into the macro workbook
on a worksheet titled "Clean Data"

Here is the code in its entirety:(I did not write this an individual that
wrote the macro is no longer available to consult)

Option Explicit

Public Sub Transform()

Dim settings As clsSettings
Set settings = New clsSettings

Call populateClean(settings)

End Sub

Private Sub populateClean(settings As clsSettings)

'Populate headings to clean worksheet
Call populateHeadings(settings)

'Open raw workbook and set a pointer to raw worksheet
Dim rawWrkBk As Workbook
Dim rawWrkSht As Worksheet
Set rawWrkBk = openRawWrkBk(settings)
Set rawWrkSht = rawWrkBk.Sheets(settings.getRawWrkSht)

Dim rawData As clsRawData
Set rawData = New clsRawData
Call rawData.setWrkSht(rawWrkSht)

Dim NumOfRec As Long, i As Long
NumOfRec = rawData.getNumOfRows
For i = 1 To NumOfRec
'populate the ith row
Call populateRow(i, settings, rawData)
Next i

rawWrkBk.Close

MsgBox "Number of records processed: " & rawData.getNumOfRows

End Sub

Private Sub populateRow(i As Long, settings As clsSettings, rawData As
clsRawData)

'Strategy is this:
'Pre-populate all multi-value fields by "N".
'Find the ith row in raw
'Go down in column in settings.
'If header element is (a) included (extract = Y) and (b) not multiple
value, then
'find corresponding element in ith row in raw and output to clean.
'If header element is included but multiple valued, then
'find corresponding element in ith rown in raw, read down and output
across to clean
'Where to output across depends on value of data element (if California,
then set Y to California)
'How far to read down depends on where the next data element is in raw

Call setMultiValToNo(i, settings)
Call writeToClean(i, settings, rawData)

End Sub

Private Sub writeToClean(i As Long, settings As clsSettings, rawData As
clsRawData)

'Find ith row in raw. Do it by calling a function in rawData that
returns a range
Dim clnWrkSht As Worksheet
Set clnWrkSht =
settings.getSettingsWrkBk.Worksheets(settings.getC leanWrkSht)

Dim headerRange As Range, ithRange As Range
Set headerRange = rawData.get_ith_row(0)
Set ithRange = rawData.get_ith_row(i)

Dim varHeaderRange As Variant, numHeaderRange As Long
varHeaderRange = WorksheetFunction.Transpose(headerRange)
numHeaderRange = WorksheetFunction.CountA(varHeaderRange)

Dim cols As Variant, extract, multiVal, freeFormAllowed
Dim possibleVal As Range
cols = WorksheetFunction.Transpose(settings.getColumn)
extract = WorksheetFunction.Transpose(settings.getExtract)
multiVal = WorksheetFunction.Transpose(settings.getMultipleVa lue)
freeFormAllowed = WorksheetFunction.Transpose(settings.getFreeFormAl lowed)
Set possibleVal = settings.getPossibleValues

Dim clnHeadings As Variant
clnHeadings = settings.getHeadings

Dim k As Long, j As Long, clnHeadingCntr As Long, a As Long, b As Long,
c As Long
Dim PosValAt_i As Range, PosValAt_i_Array As Variant
clnHeadingCntr = LBound(clnHeadings)

For k = LBound(varHeaderRange) To (LBound(varHeaderRange) +
numHeaderRange - 1)
If cols(k) = varHeaderRange(k, 1) Then
If (extract(k) = "Y") Then
If (multiVal(k) = "N") Then
clnHeadingCntr = clnHeadingCntr + 1
clnWrkSht.Cells(i + 1, clnHeadingCntr) =
ithRange.Cells(1, k)
Else
Set PosValAt_i = possibleVal.Rows(k)
b = WorksheetFunction.CountA(PosValAt_i)
PosValAt_i_Array = Range(possibleVal.Cells(k, 1),
possibleVal.Cells(k, b))
For a = 1 To rawData.getNumOfRowsAt_i(i)
If (Not IsEmpty(ithRange.Cells(a, k))) And
ithRange.Cells(a, k) < "" Then
c = -1
On Error Resume Next
c =
WorksheetFunction.Match(Trim(ithRange.Cells(a, k)), PosValAt_i_Array, False)
On Error GoTo 0
If c = -1 Then
If freeFormAllowed(k) = "N" Then
MsgBox "Something is wrong"
Stop
Else
clnWrkSht.Cells(i + 1, b +
clnHeadingCntr + 1) = ithRange.Cells(a, k)
End If
Else
clnWrkSht.Cells(i + 1, c + clnHeadingCntr) =
"Y"
End If
End If
Next a
clnHeadingCntr = clnHeadingCntr + b
If freeFormAllowed(k) = "Y" Then
clnHeadingCntr = clnHeadingCntr + 1
End If
End If
End If
End If
Next k

End Sub
Private Sub setMultiValToNo(i As Long, settings As clsSettings)

Dim clnWrkSht As Worksheet
Set clnWrkSht =
settings.getSettingsWrkBk.Worksheets(settings.getC leanWrkSht)

Dim cols, extract, multiVal, possibleVal, freeFormAllowed
cols = WorksheetFunction.Transpose(settings.getColumn)
extract = WorksheetFunction.Transpose(settings.getExtract)
multiVal = WorksheetFunction.Transpose(settings.getMultipleVa lue)
freeFormAllowed = WorksheetFunction.Transpose(settings.getFreeFormAl lowed)
possibleVal = settings.getPossibleValues

Dim j As Long, k As Long, m As Long, maxPosVal As Long
Dim posValRange_i As Range

j = 0
For k = LBound(cols) To UBound(cols)
If extract(k) = "Y" Then
If multiVal(k) = "Y" Then
Set posValRange_i = settings.getPossibleValues.Rows(k)
maxPosVal = WorksheetFunction.CountA(posValRange_i)
For m = 1 To maxPosVal
j = j + 1
clnWrkSht.Cells(i + 1, j) = "N"
Next m
If freeFormAllowed(k) = "Y" Then
j = j + 1
End If
Else
j = j + 1
End If
End If
Next k

End Sub

Private Function openRawWrkBk(settings As clsSettings) As Workbook

Dim wkb1 As Workbook

Application.DisplayAlerts = False

On Error Resume Next
Set wkb1 = Workbooks(settings.getRawWrkBk)
On Error GoTo 0
If wkb1 Is Nothing Then
Set wkb1 = Workbooks.Open(settings.getRawWrkBk)
End If
Set openRawWrkBk = wkb1

Application.DisplayAlerts = True

End Function


Private Sub myAddWrkSht(wrkShtName As String)

'Delete existing worksheet with same name, if exists.
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(wrkShtName).Delete
Application.DisplayAlerts = True
On Error GoTo 0

'Add worksheet
Worksheets.Add
ActiveSheet.Name = wrkShtName

End Sub
Private Sub populateHeadings(settings As clsSettings)

'Add new worksheet to store headings
Call myAddWrkSht(settings.getCleanWrkSht)

Dim clnWrkSht As Worksheet
Set clnWrkSht = Worksheets(settings.getCleanWrkSht)
clnWrkSht.Range("1:1").Value = settings.getHeadings

End Sub

"Simon Lloyd" e:


Jen_T where does the code fall down and what is the error number?, can
you explain a little of what you are trying to achieve with this code?,
i do notice that not all your variables have been declared, there may be
a problem there.

Jen_T;295683 Wrote:
Sorry about that meant to do that.. Thank you

Here the portion of the code I receive the error

Code:
--------------------

Private Sub writeToClean(i As Long, settings As clsSettings, rawData As
clsRawData)

'Find ith row in raw. Do it by calling a function in rawData that
returns a range
Dim clnWrkSht As Worksheet
Set clnWrkSht =
settings.getSettingsWrkBk.Worksheets(settings.getC leanWrkSht)

Dim headerRange As Range, ithRange As Range
Set headerRange = rawData.get_ith_row(0)
Set ithRange = rawData.get_ith_row(i)

Dim varHeaderRange As Variant, numHeaderRange As Long
varHeaderRange = WorksheetFunction.Transpose(headerRange)
numHeaderRange = WorksheetFunction.CountA(varHeaderRange)

Dim cols As Variant, extract, multiVal, freeFormAllowed
Dim possibleVal As Range
cols = WorksheetFunction.Transpose(settings.getColumn)
extract = WorksheetFunction.Transpose(settings.getExtract)
multiVal = WorksheetFunction.Transpose(settings.getMultipleVa lue)
freeFormAllowed = WorksheetFunction.Transpose(settings.getFreeFormAl lowed)
Set possibleVal = settings.getPossibleValues

Dim clnHeadings As Variant
clnHeadings = settings.getHeadings

Dim k As Long, j As Long, clnHeadingCntr As Long, a As Long, b As Long,
c As Long
Dim PosValAt_i As Range, PosValAt_i_Array As Variant
clnHeadingCntr = LBound(clnHeadings)

For k = LBound(varHeaderRange) To (LBound(varHeaderRange) +
numHeaderRange - 1)
If cols(k) = varHeaderRange(k, 1) Then
If (extract(k) = "Y") Then
If (multiVal(k) = "N") Then
clnHeadingCntr = clnHeadingCntr + 1
clnWrkSht.Cells(i + 1, clnHeadingCntr) =
ithRange.Cells(1, k)
Else
Set PosValAt_i = possibleVal.Rows(k)
b = WorksheetFunction.CountA(PosValAt_i)
PosValAt_i_Array = Range(possibleVal.Cells(k, 1),
possibleVal.Cells(k, b))
For a = 1 To rawData.getNumOfRowsAt_i(i)
If (Not IsEmpty(ithRange.Cells(a, k))) And
ithRange.Cells(a, k) < "" Then
c = -1
On Error Resume Next
c =
WorksheetFunction.Match(Trim(ithRange.Cells(a, k)), PosValAt_i_Array, False)
On Error GoTo 0
If c = -1 Then
If freeFormAllowed(k) = "N" Then
MsgBox "Something is wrong"
Stop

--------------------



"Chip Pearson" wrote:


Post the code that is causing the problem.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
'www.cpearson.com' (http://www.cpearson.com)
(email on web site)

On Fri, 3 Apr 2009 07:39:01 -0700, Jen_T
wrote:

I was wondering if anyone knows what this error means when I run a
macro i
get this error:
Method 'Default' of object 'Range' failed



--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=82532