View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] goss9394@yahoo.com is offline
external usenet poster
 
Posts: 25
Default Code logic error

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