Search for text with specific parameter and copy
 

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7 characters
(combination of 6 letters and a digit or just 7 letters). Content of those
cells need to by copy to another column in alphabetical order.

Thank you for your help

Search for text with specific parameter and copy
 

"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7 characters
(combination of 6 letters and a digit or just 7 letters). Content of those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7, however they
will be still in upper case.

Search for text with specific parameter and copy
 

Text is usually anything that isn't a number or error value. If this isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7 characters
(combination of 6 letters and a digit or just 7 letters). Content of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7, however
they
will be still in upper case.

Search for text with specific parameter and copy
 

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7 characters
(combination of 6 letters and a digit or just 7 letters). Content of those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7, however they
will be still in upper case.

Some of the text will also repeat, and only one entry is required.
Thank you again.

Search for text with specific parameter and copy
 

Hi Tom and thank you for your response.
I cannot run this macro, probably because I cannot set it up right.
I get compile error:syntax error.
This is a setting,
Data is in the column A of sheet called"WK1"
Parameters to extract
7 or less characters(letters and digits combination no spaces)
Upper case

Eliminate duplicates
Sort alphabetically
Copy to sheet called"totals" at the cell A5(starting point)

I appreciate your help on this.
Thank you

"Tom Ogilvy" wrote:

Text is usually anything that isn't a number or error value. If this isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7 characters
(combination of 6 letters and a digit or just 7 letters). Content of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7, however
they
will be still in upper case.

Search for text with specific parameter and copy
 

The compile problem was because of wordwrap in the email. Hopefully you will
be able to copy and paste this without problem.

Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Total").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Total").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom and thank you for your response.
I cannot run this macro, probably because I cannot set it up right.
I get compile error:syntax error.
This is a setting,
Data is in the column A of sheet called"WK1"
Parameters to extract
7 or less characters(letters and digits combination no spaces)
Upper case

Eliminate duplicates
Sort alphabetically
Copy to sheet called"totals" at the cell A5(starting point)

I appreciate your help on this.
Thank you

"Tom Ogilvy" wrote:

Text is usually anything that isn't a number or error value. If this
isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7
characters
(combination of 6 letters and a digit or just 7 letters). Content of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7, however
they
will be still in upper case.

Search for text with specific parameter and copy
 

Hi Tom I get another error this time "subscript out of range"
Is it possible for you to look at the file itself?
I could e-mail you with the attachemnt at your address provided here. Of
course if it is okay?
I appreciate your time and effort on this.


"Tom Ogilvy" wrote:

The compile problem was because of wordwrap in the email. Hopefully you will
be able to copy and paste this without problem.

Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Total").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Total").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom and thank you for your response.
I cannot run this macro, probably because I cannot set it up right.
I get compile error:syntax error.
This is a setting,
Data is in the column A of sheet called"WK1"
Parameters to extract
7 or less characters(letters and digits combination no spaces)
Upper case

Eliminate duplicates
Sort alphabetically
Copy to sheet called"totals" at the cell A5(starting point)

I appreciate your help on this.
Thank you

"Tom Ogilvy" wrote:

Text is usually anything that isn't a number or error value. If this
isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need to
extract only cells which contain text in upper case and has 7
characters
(combination of 6 letters and a digit or just 7 letters). Content of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7, however
they
will be still in upper case.

Search for text with specific parameter and copy
 

Subscript out of range means I misread your email and wrote the code to send
to a sheet named Total instead of Totals.

If you still have problems, my email address:


Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Totals").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Totals").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom I get another error this time "subscript out of range"
Is it possible for you to look at the file itself?
I could e-mail you with the attachemnt at your address provided here. Of
course if it is okay?
I appreciate your time and effort on this.


"Tom Ogilvy" wrote:

The compile problem was because of wordwrap in the email. Hopefully you
will
be able to copy and paste this without problem.

Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Total").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Total").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom and thank you for your response.
I cannot run this macro, probably because I cannot set it up right.
I get compile error:syntax error.
This is a setting,
Data is in the column A of sheet called"WK1"
Parameters to extract
7 or less characters(letters and digits combination no spaces)
Upper case

Eliminate duplicates
Sort alphabetically
Copy to sheet called"totals" at the cell A5(starting point)

I appreciate your help on this.
Thank you

"Tom Ogilvy" wrote:

Text is usually anything that isn't a number or error value. If this
isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need
to
extract only cells which contain text in upper case and has 7
characters
(combination of 6 letters and a digit or just 7 letters). Content
of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7,
however
they
will be still in upper case.

Search for text with specific parameter and copy
 

I have sent an e-mail.
Thank you

"Tom Ogilvy" wrote:

Subscript out of range means I misread your email and wrote the code to send
to a sheet named Total instead of Totals.

If you still have problems, my email address:


Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Totals").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Totals").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom I get another error this time "subscript out of range"
Is it possible for you to look at the file itself?
I could e-mail you with the attachemnt at your address provided here. Of
course if it is okay?
I appreciate your time and effort on this.


"Tom Ogilvy" wrote:

The compile problem was because of wordwrap in the email. Hopefully you
will
be able to copy and paste this without problem.

Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Total").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Total").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom and thank you for your response.
I cannot run this macro, probably because I cannot set it up right.
I get compile error:syntax error.
This is a setting,
Data is in the column A of sheet called"WK1"
Parameters to extract
7 or less characters(letters and digits combination no spaces)
Upper case

Eliminate duplicates
Sort alphabetically
Copy to sheet called"totals" at the cell A5(starting point)

I appreciate your help on this.
Thank you

"Tom Ogilvy" wrote:

Text is usually anything that isn't a number or error value. If this
isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I need
to
extract only cells which contain text in upper case and has 7
characters
(combination of 6 letters and a digit or just 7 letters). Content
of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7,
however
they
will be still in upper case.

Search for text with specific parameter and copy
 

I have sent it back.

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
I have sent an e-mail.
Thank you

"Tom Ogilvy" wrote:

Subscript out of range means I misread your email and wrote the code to
send
to a sheet named Total instead of Totals.

If you still have problems, my email address:


Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Totals").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Totals").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom I get another error this time "subscript out of range"
Is it possible for you to look at the file itself?
I could e-mail you with the attachemnt at your address provided here.
Of
course if it is okay?
I appreciate your time and effort on this.


"Tom Ogilvy" wrote:

The compile problem was because of wordwrap in the email. Hopefully
you
will
be able to copy and paste this without problem.

Sub ABC()
Dim rng As Range, rw As Long
Dim rng1 As Range, rng2 As Range
Dim cell As Range
rw = 5
With Worksheets("WK1")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
For Each cell In rng
If UCase(cell.Value) = cell.Value Then
If InStr(1, cell.Value, " ", _
vbTextCompare) = 0 Then
If Len(cell.Value) <= 7 Then
Worksheets("Total").Cells(rw, 1).Value = _
cell.Value
rw = rw + 1
End If
End If
End If
Next

With Worksheets("Total").Columns(1)
Set rng1 = .Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))
.Columns(2).Insert
End With
rng1.Offset(0, 1).Formula = _
"=if(countif($A$5:A5,A5)1," & _
"na(),"""")"
On Error Resume Next
Set rng2 = rng1.Offset(0, 1) _
.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng2 Is Nothing Then
Intersect(rng1, _
rng2.EntireRow).ClearContents
End If
rng1.parent.columns(2).Delete
rng1.Sort Key1:= _
rng1(1), _
Header:=xlNo
Exit Sub

End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...
Hi Tom and thank you for your response.
I cannot run this macro, probably because I cannot set it up right.
I get compile error:syntax error.
This is a setting,
Data is in the column A of sheet called"WK1"
Parameters to extract
7 or less characters(letters and digits combination no spaces)
Upper case

Eliminate duplicates
Sort alphabetically
Copy to sheet called"totals" at the cell A5(starting point)

I appreciate your help on this.
Thank you

"Tom Ogilvy" wrote:

Text is usually anything that isn't a number or error value. If
this
isn't
restrictive enough, define what is acceptable.

Sub ABC()
Dim rng as Range, rw as Long
set rng = range(cells(1,"A"),Cells(rows.count,"A").End(xlup) )
for each cell in rng
if ucase(cell.value) = cell.Value then
if len(cell.Value) <= 7 then
Worksheets("Sheet2").Cells(rw,1).Value =
cell.Value
rw = rw + 1
end if
end if
Next
Worksheets("Sheet2").Columns(1).Sort Key1:= _
Worksheets("Sheet2").Range("A1")
End Sub

--
Regards,
Tom Ogilvy

"boronmr" wrote in message
...


"boronmr" wrote:

Hi
I need to search a column full of text, symbols and blanks. I
need
to
extract only cells which contain text in upper case and has 7
characters
(combination of 6 letters and a digit or just 7 letters).
Content
of
those
cells need to by copy to another column in alphabetical order.

Thank you for your help

I need to add that needed text may have less characters then 7,
however
they
will be still in upper case.