Option Explicit
Dim cmt As Comment 'comment
Dim ws As Worksheet 'working sheet
Dim wsLog As Worksheet 'log sheet
Dim CommRange As Range 'comments range
Public Sub ReadValues() 'reads values of rows
Dim Rng As Range
Dim i As Integer
Dim cC As Integer 'character count
Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants)
'Set CommRange = Rng.Offset(1).Resize(Rng.Rows.Count - 1)
i = wsLog.Cells(Rows.Count, 1).End(xlUp).Row + 1
If Not CommRange Is Nothing Then
For Each Rng In CommRange
If Application.IsText(Rng) Then
cC = Rng.Characters.Count
End If
wsLog.Cells(i, 1).Resize(1, 7).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Formatter(Rng.Text), "", "", cC, Rng.Cells.Text)
i = i + 1
Next
End If
End Sub
ws.Cells.SpecialCells(xlCellTypeComments)
Set rng=ws.Cells(1,1).CurrentRegion.Offset(1)
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lrow As Long
Dim rng As Range
Set ws = Sheets("Data")
Set ws1 = Sheets("Log")
Set rng = ws.Cells.SpecialCells(xlCellTypeConstants)
rng.Copy ws1.Range("A1")
ws1.Rows("1:1").Delete
On Error Resume Next
ws.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
Option Explicit
Dim cmt As Comment 'comment
Dim ws As Worksheet 'working sheet
Dim wsLog As Worksheet 'log sheet
Dim CommRange As Range 'comments range
Public Sub ReadValues() 'reads values of rows
Dim Rng As Range
Dim i As Integer
Dim cC As Integer 'character count
Set ws = ActiveSheet
With ws
On Error GoTo err_quit
Set CommRange = .Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If Not CommRange Is Nothing Then Set CommRange = CommRange.Cells(1).CurrentRegion.Offset(1)
MsgBox CommRange.Address
End With
Exit Sub
err_quit:
MsgBox "No cells were found", vbCritical, "Quitting"
End Sub
Set ExcludedRange = ws.Cells.SpecialCells(xlCellTypeComments)
If Not CommRange Is Nothing Then Set CommRange = CommRange.Cells(1).CurrentRegion.Offset(1)
Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants).Cells(1).CurrentRegion.Offset(1)
Option Explicit
Dim cmt As Comment 'comment
Dim ws As Worksheet 'working sheet
Dim wsLog As Worksheet 'log sheet
Dim CommRange As Range 'comments range
Private Sub Class_Initialize() 'object create
Set ws = Sheets("Data")
Set wsLog = Sheets("Log")
Set CommRange = Nothing
End Sub
Private Sub Class_Terminate() 'house cleaning
Set wsLog = Nothing
Set ws = Nothing
Set CommRange = Nothing
End Sub
Public Sub ReadValues() 'reads values of rows
Dim Rng As Range
Dim i As Integer
Dim cC As Integer 'character count
Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants).Cells(1).CurrentRegion.Offset(1)
If Not CommRange Is Nothing Then
i = wsLog.Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Rng In CommRange
If Application.IsText(Rng) Then
cC = Rng.Characters.Count
End If
wsLog.Cells(i, 1).Resize(1, 7).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Rng.Text, "", "", cC, Rng.Cells.Text)
i = i + 1
Next
End If
End Sub
Message Reference Company Name Company Name Company Address Other Info Message Text Info Customer Account Currency Balance in original currency Balance in CHF
M1 R1 CompanyName OtherName "Somestreet 1, New York" CS UH2 Local 345612 80012354 USD 10000 10127.25
M1 R2 CompanyName OtherName "Somestreet 1, New York" CS UH2 Local 345612 80012368 CHF 95640.7 95640.7
M1 R3 CompanyName OtherName "Somestreet 1, New York" CS UH2 Local 345612 80012394 GBP 143000 211107.75
M1 R4 CompanyName "Somestreet 1, New York" CS UH2 Local 425078 80024301 CHF 85000 85000
M1 R5 CompanyName "Somestreet 1, New York" CS UH2 Local 425078 80025961 USD 12000 12152.7
M1 R6 CompanyName "Somestreet 1, New York" CS UH2 Mandate 428640 800168001 USD 695000 703843.88
M1 R7 CompanyName "Somestreet 1, New York" CS UH1 Local 354016 80025601 CHF 120000 120000
M1 R8 CompanyName "Somestreet 1, New York" CS UH1 Local 354016 80025646 CHF 52945.58 52945.58
M1 R9 CompanyName "Somestreet 1, New York" CS UH2 Mandate 428751 800168215 USD 425000 430408.13
M1 R10 CompanyName "Somestreet 1, New York" CS UH1 Local 377677 80031255 CHF 120000 120000
Option Explicit
Dim cmt As Comment 'comment
Dim ws As Worksheet 'working sheet
Dim wsLog As Worksheet 'log sheet
Dim CommRange As Range 'comments range
Private Sub Class_Initialize() 'object create
Set ws = Sheets("Data")
Set wsLog = Sheets("Log")
Set CommRange = Nothing
End Sub
Private Sub Class_Terminate() 'house cleaning
Set wsLog = Nothing
Set ws = Nothing
Set CommRange = Nothing
End Sub
Public Sub ReadValues() 'reads values of rows
Dim Rng As Range
Dim i As Integer
Dim cC As Integer 'character count
Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants).Cells(1).CurrentRegion.Offset(1)
If Not CommRange Is Nothing Then
i = wsLog.Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Rng In CommRange
If Application.IsText(Rng) Then
cC = Rng.Characters.Count
End If
wsLog.Cells(i, 1).Resize(1, 7).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Formatter(Rng.Text), "", "", cC, Rng.Cells.Text)
i = i + 1
Next
End If
FormatLog
End Sub
Public Sub ReadHeaders() 'reads comments from top of columns to build the XML headers
Dim i As Integer
Dim Rng As Range
Application.ScreenUpdating = False
Set CommRange = ws.Cells.SpecialCells(xlCellTypeComments)
With wsLog
If .Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
.Cells(1, 1).Value = "Date Time / Source"
.Cells(1, 2).Value = "Address"
.Cells(1, 3).Value = "Data Column"
.Cells(1, 4).Value = "XML Element"
.Cells(1, 5).Value = "Required"
.Cells(1, 6).Value = "Length"
.Cells(1, 7).Value = "Data"
End If
i = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(i, 1).Value = Format(CStr(Now), "yyyy-mm-dd_hh:mm:ss")
If Not CommRange Is Nothing Then
For Each Rng In CommRange
i = i + 1
.Cells(i, 1).Resize(1, 5).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Rng.Value, Formatter(Rng.Comment.Text), Rng.Comment.Shape.TextFrame.Characters.Font.Bold)
Next
End If
Set CommRange = Nothing
FormatLog
End With
Application.ScreenUpdating = True
End Sub
Private Function Formatter(ByVal varVal As Variant) 'formats the comment text before log writing
Dim NewVal As Variant
If IsMissing(varVal) Then
Exit Function
End If
NewVal = Trim(varVal) 'remove spaces
With Application.WorksheetFunction
NewVal = .Clean(NewVal) 'remove most unwanted characters
NewVal = .Substitute(NewVal, Chr(10), "") 'remove carriage return
NewVal = .Substitute(NewVal, Chr(13), "") 'remove line feed
NewVal = .Substitute(NewVal, Chr(127), "") 'remove ASCII#127
NewVal = .Substitute(NewVal, Chr(160), "") 'remove ASCII#160
End With
Formatter = "'" & NewVal
End Function
Private Function FormatLog()
With wsLog.Cells 'log sheet format
.ClearFormats
.HorizontalAlignment = xlLeft
.Font.Name = "Courier New"
.Font.Size = 10
.Font.FontStyle = "Regular"
.Font.Color = vbBlack
.Interior.ColorIndex = xlColorIndexNone '.Interior.ColorIndex = 120
.Borders.LineStyle = xlNone
.Rows.RowHeight = 13.2
.EntireColumn.AutoFit
End With
End Function
Option Explicit
Public Sub Process_Read()
Dim Process As New Process
Process.ReadHeaders
Process.ReadValues
End Sub
Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants)
CommRange.Select
Stop
You will notice the non-empty cells are not being selected - just the ones the SpecialCells are being selecting.Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants)
gets only the full cells leaving the blank outs, while we try to deselect the first row (Roy_Cox solution)Set CommRange = ws.Cells.SpecialCells(xlCellTypeConstants).Cells(1).CurrentRegion.Offset(1)
we get also the blank cells.Message Reference Company Name Company Name Company Address Other Info Message Text Info Customer Account Currency Balance in original currency Balance in CHF
M1 R1 CompanyName OtherName Somestreet 1, New York CS UH2 Local 345612 80012354 USD 10000 10127.25
M1 R2 CompanyName OtherName Somestreet 1, New York CS UH2 Local 345612 80012368 CHF 95640.7 95640.7
M1 R3 CompanyName OtherName Somestreet 1, New York CS UH2 Local 345612 80012394 GBP 143000 211107.75
M1 R4 CompanyName Somestreet 1, New York CS UH2 Local 425078 80024301 CHF 85000 85000
M1 R5 CompanyName Somestreet 1, New York CS UH2 Local 425078 80025961 USD 12000 12152.7
M1 R6 CompanyName Somestreet 1, New York CS UH2 Mandate 428640 800168001 USD 695000 703843.88
M1 R7 CompanyName Somestreet 1, New York CS UH1 Local 354016 80025601 CHF 120000 120000
M1 R8 CompanyName Somestreet 1, New York CS UH1 Local 354016 80025646 CHF 52945.58 52945.58
M1 R9 CompanyName Somestreet 1, New York CS UH2 Mandate 428751 800168215 USD 425000 430408.13
M1 R10 CompanyName Somestreet 1, New York CS UH1 Local 377677 80031255 CHF 120000 120000
Public Sub ReadValues() 'reads values of rows
Dim Rng As Range
Dim i As Integer
Dim cC As Integer 'character count
On Error GoTo sQuit
Application.ScreenUpdating = False
Set CommRange = ws.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If Not CommRange Is Nothing Then
Set CommRange = Range(CommRange.Cells(1), Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeConstants)
i = wsLog.Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Rng In CommRange
If Application.IsText(Rng) Then
cC = Rng.Characters.Count
End If
wsLog.Cells(i, 1).Resize(1, 7).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Formatter(Rng.Text), "###", "###", cC, Rng.Cells.Text)
i = i + 1
Next
End If
FormatLog
sQuit:
Application.ScreenUpdating = True
End Sub
Message|Reference|Company Name|Company Name|Company Address|Other Info|Message Text Info|Customer|Account|Currency|Balance in original currency|Balance in CHF
M1|R1|CompanyName|OtherName|"Somestreet 1, New York"|CS UH2|Local|345612|80012354|USD|10000|10127.25
M1|R2|CompanyName|OtherName|"Somestreet 1, New York"|CS UH2|Local|345612|80012368|CHF|95640.7|95640.7
M1|R3|CompanyName|OtherName|"Somestreet 1, New York"|CS UH2|Local|345612|80012394|GBP|143000|211107.75
M1|R4|CompanyName||"Somestreet 1, New York"|CS UH2|Local|425078|80024301|CHF|85000|85000
||CompanyName||"Somestreet 1, New York"|CS UH2|Local|425078|80025961|USD|12000|12152.7
M1|R6|CompanyName||"Somestreet 1, New York"|CS UH2|Mandate|428640|800168001|USD|695000|703843.88
M1|R7|CompanyName||"Somestreet 1, New York"|CS UH1|Local|354016|80025601|CHF|120000|120000
M1|R8|CompanyName||"Somestreet 1, New York"|CS UH1|Local|354016|80025646|CHF|52945.58|52945.58
M1|R9|CompanyName||"Somestreet 1, New York"|CS UH2|Mandate|428751|800168215|USD|425000|430408.13
M1|R10|CompanyName||"Somestreet 1, New York"|CS UH1|Local|377677|80031255|CHF|120000|120000
Option Explicit
Dim cmt As Comment 'comment
Dim ws As Worksheet 'working sheet
Dim wsLog As Worksheet 'log sheet
Dim CommRange As Range 'comments range
Public Sub ReadValues() 'reads values of rows
Dim Rng As Range
Dim i As Integer
Dim cC As Integer 'character count
On Error GoTo sQuit
Application.ScreenUpdating = False
Set CommRange = ws.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If Not CommRange Is Nothing Then
'need confirmation
Set CommRange = Range(CommRange.Cells(2, Columns.Count), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
i = wsLog.Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Rng In CommRange
If Application.IsText(Rng) Then
cC = Rng.Characters.Count
End If
wsLog.Cells(i, 1).Resize(1, 7).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Formatter(Rng.Text), "###", "###", cC, Rng.Cells.Text)
i = i + 1
Next
End If
FormatLog
sQuit:
Application.ScreenUpdating = True
End Sub
Public Sub ReadHeaders() 'reads comments from top of columns to build the XML headers
Dim i As Integer
Dim Rng As Range
On Error GoTo sQuit
Application.ScreenUpdating = False
Set CommRange = ws.Cells.SpecialCells(xlCellTypeComments)
With wsLog
If .Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
.Cells(1, 1).Value = "Date Time / Source"
.Cells(1, 2).Value = "Address"
.Cells(1, 3).Value = "Data Column"
.Cells(1, 4).Value = "XML Element"
.Cells(1, 5).Value = "Required"
.Cells(1, 6).Value = "Length"
.Cells(1, 7).Value = "Data"
End If
i = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(i, 1).Value = Format(CStr(Now), "yyyy-mm-dd_hh:mm:ss")
If Not CommRange Is Nothing Then
For Each Rng In CommRange
i = i + 1
.Cells(i, 1).Resize(1, 5).Value = _
Array(ws.Name, Rng.Address(ReferenceStyle:=xlR1C1), Rng.Value, Formatter(Rng.Comment.Text), Rng.Comment.Shape.TextFrame.Characters.Font.Bold)
Next
End If
Set CommRange = Nothing
FormatLog
End With
Application.ScreenUpdating = True
sQuit:
Application.ScreenUpdating = True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Private Functions ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize() 'object create
Set ws = Sheets("Data")
Set wsLog = Sheets("Log")
Set CommRange = Nothing
End Sub
Private Sub Class_Terminate() 'house cleaning
Set wsLog = Nothing
Set ws = Nothing
Set CommRange = Nothing
End Sub
Private Function Formatter(ByVal varVal As Variant) 'formats the comment text before log writing
Dim NewVal As Variant
If IsMissing(varVal) Or Len(varVal) < 1 Then
Get_Variable_Type (varVal)
Exit Function
End If
NewVal = Trim(varVal) 'remove spaces
With Application.WorksheetFunction
NewVal = .Clean(NewVal) 'remove most unwanted characters
NewVal = .Substitute(NewVal, Chr(10), "") 'remove carriage return
NewVal = .Substitute(NewVal, Chr(13), "") 'remove line feed
NewVal = .Substitute(NewVal, Chr(127), "") 'remove ASCII#127
NewVal = .Substitute(NewVal, Chr(160), "") 'remove ASCII#160
End With
Formatter = "'" & NewVal
End Function
Private Function FormatLog()
With wsLog.Cells 'log sheet format
.ClearFormats
.HorizontalAlignment = xlLeft
.Font.Name = "Courier New"
.Font.Size = 10
.Font.FontStyle = "Regular"
.Font.Color = vbBlack
.Interior.ColorIndex = xlColorIndexNone '.Interior.ColorIndex = 120
.Borders.LineStyle = xlNone
.Rows.RowHeight = 13.2
.EntireColumn.AutoFit
End With
End Function
Public Sub Process_Read()
Dim Process As New Process
Process.ReadHeaders
Process.ReadValues
End Sub
Assuming row-1 has headers..
Open in new window
Saurabh...