O
OssieMac
Hello All,
The following code sums values created using 2 ^ n for various invalid data.
There is a method of then extracting the individual values from the summed
total to identify the individual messages. I can’t remember how to do this
and have not been successful in finding it so any help will be appreciated.
I know there are other ways of creating the list of messages but I
particularly want the code for this method. (The code below is simply an
example. What I am really after is code to create an individual number to use
as an argument/parameter in a different situation. I can create the number as
below but cannot extract the individual values that have been summed.)
Sub Test_Valid_Range()
'Invalid data table.
'2 ^ 0 = 1 Header row not included in selection.
'2 ^ 1 = 2 Require minimum 2 rows and 2 columns.
'2 ^ 2 = 4 Blank column headers not permitted.
'2 ^ 3 = 8 Duplicate column headers not permitted.
'2 ^ 4 = 16 Blank data cells not permitted.
Dim rngSelect As Range
Dim lngInvalid As Long
Dim i As Long
Dim strMsge As String
On Error Resume Next
Set rngSelect = Application.InputBox _
(Prompt:="Select the required range", Type:=8)
If rngSelect Is Nothing Then
MsgBox "No range selected or user cancelled." & vbLf & _
"Processing terminated."
Exit Sub
End If
lngInvalid = 0
With rngSelect
'Test that header row is included in selection
If .Cells(1, 1).Row <> 1 Then
lngInvalid = lngInvalid + 2 ^ 0
End If
'Test for at least 2 rows and 2 columns
If .Rows.Count < 2 Or .Columns.Count < 2 Then
lngInvalid = lngInvalid + 2 ^ 1
End If
'Test for no blank column headers
If WorksheetFunction.CountBlank(.Rows(1)) > 0 Then
lngInvalid = lngInvalid + 2 ^ 2
End If
'Test for duplicate column headers
For i = 1 To .Columns.Count
If WorksheetFunction.CountIf(.Rows(1), _
.Cells(1, i)) > 1 Then
lngInvalid = lngInvalid + 2 ^ 3
Exit For 'Must cease testing on first duplicate
End If
Next i
'Test for blank cells within data range.
If WorksheetFunction.CountBlank(.Range(.Cells(2, 1), _
.Cells(.Rows.Count, .Columns.Count))) > 0 Then
lngInvalid = Invalid + 2 ^ 4
End If
End With
MsgBox lngInvalid 'for testing only
'*************************************
'How to process the sum of lngInvalid
'to extract individual values to match to messages.
'*************************************
End Sub
The following code sums values created using 2 ^ n for various invalid data.
There is a method of then extracting the individual values from the summed
total to identify the individual messages. I can’t remember how to do this
and have not been successful in finding it so any help will be appreciated.
I know there are other ways of creating the list of messages but I
particularly want the code for this method. (The code below is simply an
example. What I am really after is code to create an individual number to use
as an argument/parameter in a different situation. I can create the number as
below but cannot extract the individual values that have been summed.)
Sub Test_Valid_Range()
'Invalid data table.
'2 ^ 0 = 1 Header row not included in selection.
'2 ^ 1 = 2 Require minimum 2 rows and 2 columns.
'2 ^ 2 = 4 Blank column headers not permitted.
'2 ^ 3 = 8 Duplicate column headers not permitted.
'2 ^ 4 = 16 Blank data cells not permitted.
Dim rngSelect As Range
Dim lngInvalid As Long
Dim i As Long
Dim strMsge As String
On Error Resume Next
Set rngSelect = Application.InputBox _
(Prompt:="Select the required range", Type:=8)
If rngSelect Is Nothing Then
MsgBox "No range selected or user cancelled." & vbLf & _
"Processing terminated."
Exit Sub
End If
lngInvalid = 0
With rngSelect
'Test that header row is included in selection
If .Cells(1, 1).Row <> 1 Then
lngInvalid = lngInvalid + 2 ^ 0
End If
'Test for at least 2 rows and 2 columns
If .Rows.Count < 2 Or .Columns.Count < 2 Then
lngInvalid = lngInvalid + 2 ^ 1
End If
'Test for no blank column headers
If WorksheetFunction.CountBlank(.Rows(1)) > 0 Then
lngInvalid = lngInvalid + 2 ^ 2
End If
'Test for duplicate column headers
For i = 1 To .Columns.Count
If WorksheetFunction.CountIf(.Rows(1), _
.Cells(1, i)) > 1 Then
lngInvalid = lngInvalid + 2 ^ 3
Exit For 'Must cease testing on first duplicate
End If
Next i
'Test for blank cells within data range.
If WorksheetFunction.CountBlank(.Range(.Cells(2, 1), _
.Cells(.Rows.Count, .Columns.Count))) > 0 Then
lngInvalid = Invalid + 2 ^ 4
End If
End With
MsgBox lngInvalid 'for testing only
'*************************************
'How to process the sum of lngInvalid
'to extract individual values to match to messages.
'*************************************
End Sub