Hi all

I must have a code logic error
I receive no errors at run-time
But I also don't receive any results

Code below
Drop me an e-mail if you would like the book with code
Remove nothere
Add .yah... (you know the rest)

Thanks
-goss


'Evaluate the cell
'If numeric, do nothing,
'Otherwise return only left 2 characters to the cell
'''''''''''''''''''''''''''''''
'Get_Rows is UDF
With wsData
For Each C In Range("B1:B" & Get_Rows)
If IsNumeric(C) Then
C = C * 1
Else
C = Left(C, 2)
End If
Next C
End With
''''''''''''''''''''''''''''''''''''''

'Evaluate for inner string
'If true concatenate with adjacent cell
'Return result to original cell
''''''''''''''''''''''''''''''''
'lngRows = Get_Rows
Do While lngRows = 1
For Each C In aRng
If InStr(C, "07-01") = 1 Then
C = C & Cells(lngRows, 2)
'C = Concatenate(C, Cells(Get_Rows, 2)) 'Tried First
Else
C = 0
End If
Next C
lngRows = lngRows - 1
Loop
'''''''''''''''''''''''''''''''''''''

Full Code:
'''''''''''''''''''''''''''''''''''''
Sub dewr_GetUnitNumbers()
'Get_Rows is UDF
'Globals : wbBook, wsData, wsFormulas, wsHeader, rnFormula
Dim aRng As Range
Dim lngRows As Long

Set wbBook = ThisWorkbook

With wbBook
Set wsData = .Worksheets("Data")
Set wsFormulas = .Worksheets("Formulas")
End With

With wsFormulas
Set rnFormula = .Range("A1:B1")
End With

With wsData
.Range("A1:B1").EntireColumn.Insert
.Range("A1:B" & Get_Rows).Formula = rnFormula.Formula
.Range("A1:B" & Get_Rows).Copy
.Range("A1:B" & Get_Rows).PasteSpecial
xlPasteValuesAndNumberFormats
.Range("A1:B" & Get_Rows).PasteSpecial xlPasteFormats
.Range ("A1")
End With

With wsData
For Each C In Range("B1:B" & Get_Rows)
If IsNumeric(C) Then
C = C * 1
Else
C = Left(C, 2)
End If
Next C
End With

With wsData
Set aRng = .Range("A1:A" & Get_Rows)
End With

lngRows = Get_Rows

Do While lngRows = 1
For Each C In aRng
If InStr(C, "07-01") = 1 Then
C = C & Cells(lngRows, 2)
'C = Concatenate(C, Cells(Get_Rows, 2)) 'Tried First
Else
C = 0
End If
Next C
lngRows = lngRows - 1
Loop

'Tidy up
Set wbBook = Nothing
Set wsData = Nothing
Set wsFormulas = Nothing
Set rnFormula = Nothing

End Sub

Goss,

The first routine seems to work. This is what I tried:

'Evaluate the cell
'If numeric, do nothing,
'Otherwise return only left 2 characters to the cell
'''''''''''''''''''''''''''''''
'Get_Rows is UDF

Dim c As Range
Dim wsData As Object

With wsData ' unnecessary -- not used
For Each c In Range("B1:B" & Get_Rows) '
If IsNumeric(c) Then
Else
c = Left(c, 2)
End If
Next c
End With
''''''''''''''''''''''''''''''''''''''

Function Get_Rows() As Integer
Get_Rows = 5
End Function

Or you could write:
If Not IsNumeric(C) Then C = Left(C, 2)

--
Earl Kiosterud
www.smokeylake.com


wrote in message
oups.com...
Hi all

I must have a code logic error
I receive no errors at run-time
But I also don't receive any results

Code below
Drop me an e-mail if you would like the book with code
Remove nothere
Add .yah... (you know the rest)

Thanks
-goss


'Evaluate the cell
'If numeric, do nothing,
'Otherwise return only left 2 characters to the cell
'''''''''''''''''''''''''''''''
'Get_Rows is UDF
With wsData
For Each C In Range("B1:B" & Get_Rows)
If IsNumeric(C) Then
C = C * 1
Else
C = Left(C, 2)
End If
Next C
End With
''''''''''''''''''''''''''''''''''''''

'Evaluate for inner string
'If true concatenate with adjacent cell
'Return result to original cell
''''''''''''''''''''''''''''''''
'lngRows = Get_Rows
Do While lngRows = 1
For Each C In aRng
If InStr(C, "07-01") = 1 Then
C = C & Cells(lngRows, 2)
'C = Concatenate(C, Cells(Get_Rows, 2)) 'Tried First
Else
C = 0
End If
Next C
lngRows = lngRows - 1
Loop
'''''''''''''''''''''''''''''''''''''

Full Code:
'''''''''''''''''''''''''''''''''''''
Sub dewr_GetUnitNumbers()
'Get_Rows is UDF
'Globals : wbBook, wsData, wsFormulas, wsHeader, rnFormula
Dim aRng As Range
Dim lngRows As Long

Set wbBook = ThisWorkbook

With wbBook
Set wsData = .Worksheets("Data")
Set wsFormulas = .Worksheets("Formulas")
End With

With wsFormulas
Set rnFormula = .Range("A1:B1")
End With

With wsData
.Range("A1:B1").EntireColumn.Insert
.Range("A1:B" & Get_Rows).Formula = rnFormula.Formula
.Range("A1:B" & Get_Rows).Copy
.Range("A1:B" & Get_Rows).PasteSpecial
xlPasteValuesAndNumberFormats
.Range("A1:B" & Get_Rows).PasteSpecial xlPasteFormats
.Range ("A1")
End With

With wsData
For Each C In Range("B1:B" & Get_Rows)
If IsNumeric(C) Then
C = C * 1
Else
C = Left(C, 2)
End If
Next C
End With

With wsData
Set aRng = .Range("A1:A" & Get_Rows)
End With

lngRows = Get_Rows

Do While lngRows = 1
For Each C In aRng
If InStr(C, "07-01") = 1 Then
C = C & Cells(lngRows, 2)
'C = Concatenate(C, Cells(Get_Rows, 2)) 'Tried First
Else
C = 0
End If
Next C
lngRows = lngRows - 1
Loop

'Tidy up
Set wbBook = Nothing
Set wsData = Nothing
Set wsFormulas = Nothing
Set rnFormula = Nothing

End Sub