Testing length of a number

[Dee Sperling]

I need to add text to the beginning of a number if it starts with 7 and has a
length of 5 digits.

Below is what I wrote, but it puts the text in front of every number that
starts with 7, regardless of length. What did I do wrong?

Range("A2").Select
RowCount = 2
'do this as long as there is anything in column A
Do While Range("A" & (RowCount + 1)) <> ""
'if PTAN starts with 7 and is 5 digits long, prepend with QQQQQ0
If (Left(Range("B" & RowCount), 1) = 7 And _
(Len(Range("B" & RowCount) = 5))) Then
Range("B" & RowCount) = "QQQQQ0" & Range("B" & RowCount)
RowCount = RowCount + 1
Else
RowCount = RowCount + 1
End If
Loop

The reason I'm doing this is that I need to have the leading zeros retained.
I will then be concatenating the numbers to the first cell in the row (using
the code that Joel so graciously wrote for me), separated by spaces. I will
then replace all the QQQQQ with nothing.

Thank you for your time. Any input is gratefully accepted.

Dee Sperling

 

[Lars-Åke Aspelin]

I need to add text to the beginning of a number if it starts with 7 and has a
length of 5 digits.

Below is what I wrote, but it puts the text in front of every number that
starts with 7, regardless of length. What did I do wrong?

Range("A2").Select
RowCount = 2
'do this as long as there is anything in column A
Do While Range("A" & (RowCount + 1)) <> ""
'if PTAN starts with 7 and is 5 digits long, prepend with QQQQQ0
If (Left(Range("B" & RowCount), 1) = 7 And _
(Len(Range("B" & RowCount) = 5))) Then
Range("B" & RowCount) = "QQQQQ0" & Range("B" & RowCount)
RowCount = RowCount + 1
Else
RowCount = RowCount + 1
End If
Loop

The reason I'm doing this is that I need to have the leading zeros retained.
I will then be concatenating the numbers to the first cell in the row (using
the code that Joel so graciously wrote for me), separated by spaces. I will
then replace all the QQQQQ with nothing.

Thank you for your time. Any input is gratefully accepted.

Dee Sperling

This is wrong:

Len(Range("B" & RowCount) = 5)

It should be like

Len(Range("B" & RowCount)) = 5

Hope this helps / Lars-Åke

 

[Lars-Åke Aspelin]

This is wrong:

Len(Range("B" & RowCount) = 5)

It should be like

Len(Range("B" & RowCount)) = 5

Hope this helps / Lars-Åke

5 happens to the number of characters in FALSE
And FALSE is what the expression
Range("B" & RowCount) = 5
is evaluated to.

Lars-Åke

 

[Rick Rothstein]

First of all, you do NOT have to add text to the beginning of your number
with QQQQQ0 only to replace your QQQQQ with the empty string later on... it
is just should not be necessary to do something like that. Why don't you
show us some examples of numbers you have and what you want them to look
like afterwards and we'll give you a more straightforward approach than the
one you are trying to implement.

 

[Dee Sperling]

Thank you both.

This is the code I'm using:
Sub formatSerialNum6digits()
'put all SerialNums (for rows where the recnum, last name,
'first name, and middle initial match the row above)
'into the SerialNum column of the first row.
Range("A2").Select
RowCount = 2
'As long as the current record number is the same as
'the next record number, do this process.
Do While Range("A" & (RowCount + 1)) <> ""
'if SerialNum starts with 7, format with leading zero
If (Left(Range("B" & RowCount), 1) = 7 And _
(Len(Range("B" & RowCount) = 5))) Then
Range("B" & RowCount) = "QQQQQ0" & Range("B" & RowCount)
RowCount = RowCount + 1
Else
RowCount = RowCount + 1
End If
Loop
Range("A2").Select
RowCount = 2

Do While Range("A" & (RowCount + 1)) <> ""
'set variable OldRecNum to the current record number
OldRecNum = Range("A" & RowCount)
'set variable OldSerialNum to current SerialNum
OldLastName = Range("C" & RowCount)

'set variable NewRecNum to the record number
'below the current record number
NewRecNum = Range("A" & (RowCount + 1))
'set variable NewRecNum to the record number
'below the current record number("A" & (RowCount + 1))
'set variable NewPLastName to the Last ("A" & RowCount)Name
'below the current Last Name
NewLastName = Range("C" & (RowCount + 1))
'if the Record Number in the current cell
'is the same as the one below, add the SerialNum in the
'cell below to the current SerialNum
If (OldRecNum = NewRecNum) And _
(OldLastName = NewLastName) Then
Range("B" & RowCount) = Range("B" & RowCount) & " " & Range("B" &
(RowCount + 1))
'delete the row below the current row
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop
'remove QQQQQ
Cells.Replace What:="QQQQQ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

------------------------------------------------------------------------------------------
Here's the data I'm using to test this
RecNum SerialNum LastName
3 71234 smith
3 319993 smith
3 455555 smith
3 1234567 smith
3 73339 smith
3 4239777 smith
3 77339922 smith
3 4444494 smith
3 777123 smith
5 9898989 jones
5 9999999 jones
5 3333333 jones
5 33338888 jones

-------------------------------------------------------------------------------------
When I'm finished, all the SerialNums should be in the same cell, separated
by a space, with the data consolidated, so that the data from each RecNum is
on only one row, as below.

RecNum SerialNum LastName
3 071234 319993 455555 1234567 073339 4239777 77339922 4444494 777123 smith
5 9898989 9999999 3333333 33338888 jones

 

[Rick Rothstein]

I believe this code does what you want...

Sub CollapseData()
Dim X As Long, LastRow As Long, Index As Long
Dim R As Variant, V() As Variant, SerNum As String
Index = 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
ReDim V(1 To LastRow + 1, 1 To 3)
R = Range("A2:C" & LastRow + 1)
For X = 1 To LastRow - 1
SerNum = SerNum & " " & Left("0", -(R(X, 2) Like "7####")) & R(X, 2)
If R(X, 1) <> R(X + 1, 1) Or R(X, 3) <> R(X + 1, 3) Then
V(Index, 1) = R(X, 1)
V(Index, 2) = SerNum
V(Index, 3) = R(X, 3)
SerNum = ""
Index = Index + 1
End If
Next
Range("A2:C" & (LastRow + 1)) = V
End Sub

 

[Dee Sperling]

Rick,

Thank you.

I ran the code against another set of data and it only added the leading 0
to the SerialNums that had more than 1 entry for that RecNum.

Here's the data I used for testing:
Record Number SerialNum Last Name
4883 71111 Orange
4983 1288888 Purple
5019 72222 Green
5078 73333 Red
5078 72314 Red
5078 79586 Red
5078 70005 Red
5078 72020 Red
5078 73030 Red
5078 76565 Red
5078 78585 Red
5078 79955 Red
5078 333333 Red
5078 77777 Blue
5078 79494 Blue
5078 78484 Blue
5078 77777 Blue
5078 78888 Blue
5078 72222 Blue
5078 75555 Blue
5078 70099 Blue
5078 78080 Blue
5078 312321 Blue

Dee

 

[Rick Rothstein]

Sorry, I made a last minute change to the approach I used in my code and
forgot to properly account for it. Give this code a try instead...

Sub CollapseData()
Dim X As Long, LastRow As Long, Index As Long
Dim R As Variant, V() As Variant, SerNum As String
Index = 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
ReDim V(1 To LastRow + 1, 1 To 3)
R = Range("A2:C" & LastRow + 1)
For X = 1 To LastRow - 1
SerNum = SerNum & " " & Left("0", -(R(X, 2) Like "7####")) & R(X, 2)
If R(X, 1) <> R(X + 1, 1) Or R(X, 3) <> R(X + 1, 3) Then
V(Index, 1) = R(X, 1)
V(Index, 2) = SerNum
V(Index, 3) = R(X, 3)
SerNum = ""
Index = Index + 1
End If
Next
Range("A2:C" & (LastRow + 1)).NumberFormat = "@"
Range("A2:C" & (LastRow + 1)) = V
End Sub