G
goss9394
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
(e-mail address removed)
'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
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
(e-mail address removed)
'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