formbyg
11-13-2016, 05:23 PM
VBA newbie looking for assistance, for Database generated Cable Schedule report
Multiple property data is populated off to the R/H side of the final displayed report in Defined Name Columns
For every instance that there is a Cable Item Tag in Column 'A' (defined name, col_ARep_CabItemTag = $A:$A) do the following;-
If Cable originates or terminates at a Circuit, return Power Distribution Board (PDB) Item Tag. (This part works OK)
If Cable originates from Transformer Component (secondary), return Transformer Item Tag. (This part works OK)
The 'To Side Item Descriptions' part is what is giving me trouble. (This part is not working)
Public Sub EndReport()
Dim lTotalsLastRow As Long
Dim lCurrentRow As Long
Dim lCopyRow As Long
Dim ws As Worksheet
Dim iSheetNumber As Integer
Dim sFirstRowTag As String
Dim sLastRowTag As String
Dim rRange As Range
Dim sCleaning As String
Set ws = Sheets("Sheet1")
iSheetNumber = 1
lCurrentRow = 1
With ws
lTotlsLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For lCopyRow = 9 To lTotalsLastRow '(Start Copy from Row 9 to last non-empty Row)
'From Side Item Tags
If (.Cells(lCopyRow, [col_From_EESubClass].Column) = "Circuit" And .Cells(lCopyRow, [col_From_PDB].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_FromItemTag].Column) = .Cells(lCopyRow, [col_From_PDB].Column)
Else
.Cells(lCopyRow, [col_ARep_FromItemTag].Column) = .Cells(lCopyRow, [col_From_ItemTag].Column)
If (.Cells(lCopyRow, [col_From_EESubClass].Column) = "Transformer Component" And .Cells(lCopyRow, [col_From_TransformerItemTag].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_FromItemTag].Column) = .Cells(lCopyRow, [col_From_TransformerItemTag].Column)
End If
End If
'To Side Item Tags
If (.Cells(lCopyRow, [col_To_EESubClass].Column) = "Circuit" And .Cells(lCopyRow, [col_To_PDB].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_ToItemTag].Column) = .Cells(lCopyRow, [col_To_PDB].Column)
Else
.Cells(lCopyRow, [col_ARep_ToItemTag].Column) = .Cells(lCopyRow, [col_To_ItemTag].Column)
End If
'To Side Item Descriptions (Not working)
If (.Cells(lCopyRow, [col_To_EESubClass].Column) = "Motor" And .Cells(lCopyRow, [col_To_ItemDesc].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_ToItemDesc].Column) = .Cells(lCopyRow, [col_To_ItemDesc].Column)
sCleaning = .Cells(lCopyRow + 1, [col_To_ItemDesc].Column)
sCleaning = Replace(sCleaning, Chr(10), Chr(44), 1, -1, vbBinaryCompare)
sCleaning = .Cells(lCopyRow + 1, [col_ARep_ToItemDesc].Column) '(Strip out Line Breaks From Descriptions)
End If
Next
End With
End Sub
Multiple property data is populated off to the R/H side of the final displayed report in Defined Name Columns
For every instance that there is a Cable Item Tag in Column 'A' (defined name, col_ARep_CabItemTag = $A:$A) do the following;-
If Cable originates or terminates at a Circuit, return Power Distribution Board (PDB) Item Tag. (This part works OK)
If Cable originates from Transformer Component (secondary), return Transformer Item Tag. (This part works OK)
The 'To Side Item Descriptions' part is what is giving me trouble. (This part is not working)
Public Sub EndReport()
Dim lTotalsLastRow As Long
Dim lCurrentRow As Long
Dim lCopyRow As Long
Dim ws As Worksheet
Dim iSheetNumber As Integer
Dim sFirstRowTag As String
Dim sLastRowTag As String
Dim rRange As Range
Dim sCleaning As String
Set ws = Sheets("Sheet1")
iSheetNumber = 1
lCurrentRow = 1
With ws
lTotlsLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For lCopyRow = 9 To lTotalsLastRow '(Start Copy from Row 9 to last non-empty Row)
'From Side Item Tags
If (.Cells(lCopyRow, [col_From_EESubClass].Column) = "Circuit" And .Cells(lCopyRow, [col_From_PDB].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_FromItemTag].Column) = .Cells(lCopyRow, [col_From_PDB].Column)
Else
.Cells(lCopyRow, [col_ARep_FromItemTag].Column) = .Cells(lCopyRow, [col_From_ItemTag].Column)
If (.Cells(lCopyRow, [col_From_EESubClass].Column) = "Transformer Component" And .Cells(lCopyRow, [col_From_TransformerItemTag].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_FromItemTag].Column) = .Cells(lCopyRow, [col_From_TransformerItemTag].Column)
End If
End If
'To Side Item Tags
If (.Cells(lCopyRow, [col_To_EESubClass].Column) = "Circuit" And .Cells(lCopyRow, [col_To_PDB].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_ToItemTag].Column) = .Cells(lCopyRow, [col_To_PDB].Column)
Else
.Cells(lCopyRow, [col_ARep_ToItemTag].Column) = .Cells(lCopyRow, [col_To_ItemTag].Column)
End If
'To Side Item Descriptions (Not working)
If (.Cells(lCopyRow, [col_To_EESubClass].Column) = "Motor" And .Cells(lCopyRow, [col_To_ItemDesc].Column) <> "") Then
.Cells(lCopyRow, [col_ARep_ToItemDesc].Column) = .Cells(lCopyRow, [col_To_ItemDesc].Column)
sCleaning = .Cells(lCopyRow + 1, [col_To_ItemDesc].Column)
sCleaning = Replace(sCleaning, Chr(10), Chr(44), 1, -1, vbBinaryCompare)
sCleaning = .Cells(lCopyRow + 1, [col_ARep_ToItemDesc].Column) '(Strip out Line Breaks From Descriptions)
End If
Next
End With
End Sub