Formula to consolidate numbers?

[FJ]

Hi, I have I have a spreadsheet with about 65,000 rows. I have to
consolidate the data so that ranges of numbers with no breaks (in other
words, where the numbers increase by one) will appear in one cell. The data
looks something like this:

Beginning # Ending #
60220718 60220719
60220720 60220720
60220721 60220731
60220732 60220732
60220733 60220757
40006024 40006025
40006026 40006029
40006030 40006031

Basically, what I have to do is consolidate the data so that it will look
like this:

60220718-60220757
40006024-40006031

Is there any way to write a formula or a macro to do this?

Thanks in advance for any information.

 

[carlo]

this should do the job:

---------------------------------------------
Sub consol()

Dim f_number As Long
Dim l_number As Long
Dim sh_ As Worksheet

Set sh_ = Worksheets("sheet2")

f_number = Cells(2, 1)
l_number = Cells(2, 2)

j = 1

For i = 3 To Cells(65536, 1).End(xlUp).Row
If Cells(i, 1).Value <> l_number + 1 Then
sh_.Cells(j, 1) = f_number
sh_.Cells(j, 2) = l_number
f_number = Cells(i, 1)
j = j + 1
End If
l_number = Cells(i, 2)
Next i

sh_.Cells(j, 1) = f_number
sh_.Cells(j, 2) = l_number

End Sub
-------------------------------------------------------

exchange sheet2 with whatever your output sheet should be.

the sheet you want to consolidate has to be the activesheet, otherwise
it won't work (i was to lazy to do it properly, sorry!)

hth

Carlo

 

[Chartreuse]

Hi, Carlo, thank you so much. Your macro worked great!

 

[carlo]

You're very welcome

Carlo

Hi, Carlo, thank you so much. Your macro worked great!














- Show quoted text -

 

[FJ]

Hi, Carlo, thanks again for your help the other day. I actually have another
question about this macro. We've been given a new project. It is the same
as the old one you wrote the macro for. The only difference is that this
time the data has letters in front of the numbers. Is there any way to
change the macro so that it would do the same thing as before but include the
letters in front of the numbers?

In other words, we have the following data:

Beginning # Ending #
XYZ60220718 XYZ60220719
XYZ60220720 XYZ60220720
XYZ60220721 XYZ60220731
XYZ60220732 XYZ60220732
XYZ60220733 XYZ60220757
FMTY40006024 FMTY40006025
FMTY40006026 FMTY40006029
FMTY40006030 FMTY40006031

And ultimately they would like it to look as follows:

Beginning # Ending #
XYZ60220718 XYZ60220757
FMTY40006024 FMTY40006031

I tried to do it by first separating the text from the numbers, then running
the macro, then recombining the text and the numbers using formulas, but for
reasons that are difficult to explain here I don't seem to get the correct
result with all the entries when everything is recombined. I guess maybe
this sort of thing would have to be written into the macro code, although I
don't know. Unfortunately, I have almost no knowledge of VBA.

Thank you in advance for any help.

 

[carlo]

Hi FJ

that should be possible.
But i have some questions concerning the structure:
is it possible, that there are numbers between the letters??
--> like AAA9A99999
Are your fields sorted according to the letters?

I will tell you as soon as i have some code.

cheers carlo

 

[carlo]

Ok, i tried to do something.
I'm not quite happy with it, but it should do the trick, but it
probably could be solved in a much easier way. (But i'm not really
awake yet )

anyway, give me some feedback.

'------------------------------------------------------------
Sub consol()

Dim f_number As Double
Dim l_number As Double
Dim cell_1 As String
Dim cell_2 As String

Dim sh_ As Worksheet

Set sh_ = Worksheets("sheet2")

cell_1 = Cells(2, 1)
cell_2 = Cells(2, 2)

l_number = receiveNr(cell_2)

j = 1

For i = 3 To Cells(65536, 1).End(xlUp).Row
If receiveNr(Cells(i, 1).Value) <> l_number + 1 Then
sh_.Cells(j, 1) = cell_1
sh_.Cells(j, 2) = cell_2
cell_1 = Cells(i, 1)
j = j + 1
End If
cell_2 = Cells(i, 2)
l_number = receiveNr(cell_2)
Next i

sh_.Cells(j, 1) = cell_1
sh_.Cells(j, 2) = cell_2

End Sub
'------------------------------------------------------------
Public Function receiveNr(CellString) As Double

On Error GoTo errNum

For i = Len(CellString) - 1 To 0 Step -1
If CInt(Mid(CellString, i + 1, 1)) Then
End If
Next i

errNum:
receiveNr = CDbl(Mid(CellString, i + 2))

End Function
'------------------------------------------------------------

hth
Carlo

 

[FJ]

Hi, Carlo, thank you so much for all your help. I really do appreciate this.


To answer your questions about the structure of the data:

1. No, the data has the letters before the numbers.
2. No, the data isn't sorted by the letters. It is actually sorted by
another column of people's names that I didn't bother including because we
was told it wasn't needed. Now it seems they think that would be a nifty
thing to include as well. This whole thing is driving me crazy, but that is
another story.

Anyway, I see that you've posted some code so I will try it now and let you
know the result.

Thanks again for all your help.

 

[carlo]

Hi FJ

you're welcome.

Though i have to tell you, that the code only works, if the column is
sorted!
If it isn't sorted, we need to do it in a more complex way.

Just tell me, if you have any questions

Carlo

 

[FJ]

Hi, Carlo. Your macro worked perfectly! Why weren't you happy with it?
It worked great! I really appreciate your help on this so much. You have
no idea how much time you have saved me. The first round of this thing was
done manually which was simply dreadful and very prone to human error.

Anyway, could I ask for one last favor? Is there anyway to modify the code
one last time to include the names in the third column?

Here is the original data:

Beginning # Ending #
XYZ60220718 XYZ60220719 Doe, John
XYZ60220720 XYZ60220720 Doe, John
XYZ60220721 XYZ60220731 Doe, John
XYZ60220732 XYZ60220732 Doe, John
XYZ60220733 XYZ60220757 Doe, John
FMTY40006024 FMTY40006025 Smith, Jane
FMTY40006026 FMTY40006029 Smith, Jane
FMTY40006030 FMTY40006031 Smith, Jane

And here is how they would like it to look:

Beginning # Ending #
XYZ60220718 XYZ60220757 Doe, John
FMTY40006024 FMTY40006031 Smith, Jane

If this is not possible or is too much of a pain, I totally understand. You
have already helped me out so much and saved me an incredible of time and
work.

Anyway, I just want to thank you once again.

 

[FJ]

Hi, Carlo. I didn't realize it would only run if the column was sorted.
That's interesting. The code seemed to run fine, but there are so many rows
that I guess I would have to check them carefully to see that everything came
out all right.

Does my last request about the data being sorted by a third column to the
right with people's names make things any easier? If I sort by people's
names in the third column and then by the letter/number in the first column
then it would probably work, wouldn't it?

Thanks again for all your help.

 

[carlo]

Hi FJ

i don't know how your whole data looks like, that's why I can only
guess.

What my code does right now, is evaluate the number and look in the
next field, if the number is continuing (+1).
So you could end up with:
ABC12345600 ABC12345650
XYZ98745600 XYZ98745650
ABC12345651 ABC12345699
where the first and the third row should actually be combined!

Also, it doesn't check if the Letters are the same, that could be bad
for you,
if by any coincidence you have something like:
ABC12345600 ABC12345650
DEF12345651 DEF12345699

then you would get
ABC12345600 DEF12345699

which I don't think is the right thing, right?

On the other hand, how are the names connected to the numbers. Is it
possible that something like this happens:

ABC12345600 ABC12345650 Jane Smith
ABC12345651 ABC12345699 John Doe

what would be the output then?

I am happy that I can help you.

Cheers

Carlo

PS: I am heading home now, it's evening here, so my response may take
a while.

 

[FJ]

Hi, Carlo, thanks for explaining the code to me. I will examine the
original data carefully and let you know exactly what I'm dealing with in
terms of letters, numbers, names, sequences etc.

Thanks again for your help.

 

[FJ]

Hi, Carlo, I've had a chance to study the organization of the data, so I
think I can answer your questions.

1. In the case of what we're working with now, the data seems to be sorted
by the name in the third column and then by the letter/number combination in
column A.

2. I don't think it matters if the code checks to see if the letters are the
same, because it doesn't seem as though there are any instances like you gave
an example of:

ABC12345600 ABC12345650
DEF12345651 DEF12345699

But you're right. If there were, it should not end up as:

ABC12345600 DEF12345699

3. It doesn't seem that there are any instances of the following sort of
thing:

ABC12345600 ABC12345650 Jane Smith
ABC12345651 ABC12345699 John Doe

But if there were, the correct output would be:

ABC12345600 ABC12345650 Jane Smith
ABC12345651 ABC12345699 John Doe

Which is the same as what we started with. Even though the numbers would
usually be considered consecutive entries in this sort of case, because they
have two different names attached to them they should stay separate. I hope
I explained that right.

Anyway, I hope I'm not driving you crazy with all of this. I really
appreciate your help. I also appreciate that you've pointed out a lot of
things to watch for in the data. I should have thought of these things but I
didn't.

Thank you very much, again, for all your help.

 

[carlo]

Hey FJ

ok, listen, i threw all my code out of the window and started from
scratch considering all problematics we encountered.
Now i have a code, that considers almost everything. Exception is
(most unlikely, as i see it) if the numbers are intersected (sorry,
couldn't come up with a better word, look at the example)
ABC12345600 ABC12345650 Jane Smith
ABC12345621 ABC12345699 Jane Smith
it'll screw up somewhere.

Otherwise, the rest should be taken care of.
(maybe, there will be some word wrapping while pasting, if you have
problems, please write me a mail and i send you the excel file)
(also sorry, for the lack of commentaries, didn't have time for that
but what you need to know:
- column 1 - 3 declare where your columns are, if they should not be
on A, B and C.
- column 4 is used as a checkcolumn, if you enter 255 it shouldn't
bother your data at all, and in the end it will be erased anyways
- set inputsheet and outputsheet)

that's all, have fun:
--------------------------------------------------------------------------
Private Const Column1 As Byte = 1
Private Const Column2 As Byte = 2
Private Const Column3 As Byte = 3
Private Const Column4 As Byte = 4


Sub main()

Dim rng As Range
Dim rng_forward As Range
Dim strValue As String
Dim actRow As Double

Dim StartCell As String
Dim EndCell As String
Dim found_flag As Boolean

Dim count_ As Double
Dim inputsheet As Worksheet
Dim outputSheet As Worksheet

count_ = 2
Set inputsheet = Worksheets("sheet1")
Set outputSheet = Worksheets("sheet2")

With inputsheet

For i = 2 To .Cells(65536, Column1).End(xlUp).Row

If .Cells(i, Column4).Value <> "x" Then

actRow = i
.Cells(i, Column4).Value = "x"

strValue = .Cells(actRow, Column1)
StrName = .Cells(actRow, Column3)

Set rng = Find_Range(returnConnection(strValue,
False), .Columns(Column2))

found_flag = False

Do Until rng Is Nothing

For Each cell_ In rng.Cells

If (cell_.Offset(0, Column3 - Column2).Value =
StrName) Then

actRow = cell_.Row
strValue = .Cells(actRow, Column1)
.Cells(actRow, Column4).Value = "x"
Exit For

found_flag = True

End If

Next cell_

If found_flag Then
Set rng = Find_Range(returnConnection(strValue,
False), .Columns(Column2))
found_flag = False
Else
Set rng = Nothing
End If

Loop

StartCell = .Cells(actRow, Column1).Value
EndCell = .Cells(i, Column2).Value

Set rng = Find_Range(returnConnection(EndCell,
True), .Columns(Column1))

Do Until rng Is Nothing

For Each cell_ In rng.Cells

If (cell_.Offset(0, Column3 - Column1).Value =
StrName) Then

actRow = cell_.Row
EndCell = .Cells(actRow, Column2)
.Cells(actRow, Column4).Value = "x"
found_flag = True
Exit For

End If

Next cell_
If found_flag Then
Set rng = Find_Range(returnConnection(EndCell,
True), .Columns(Column1))
found_flag = False
Else
Set rng = Nothing
End If

Loop

outputSheet.Cells(count_, 1).Value = StartCell
outputSheet.Cells(count_, 2).Value = EndCell
outputSheet.Cells(count_, 3).Value = StrName
count_ = count_ + 1

End If

Next i

.Columns(Column4).Clear

End With

End Sub


Function returnConnection(strValue As String, Plus As Boolean) As
String

Dim a As Double
Dim b As String

For i = Len(strValue) To 1 Step -1
If Not IsNumeric(Mid(strValue, i, 1)) Then
a = CDbl(Right(strValue, Len(strValue) - i))
b = Left(strValue, i)
If Plus Then
a = a + 1
Else
a = a - 1
End If

returnConnection = b & a
Exit For
End If
Next i

End Function

Function Find_Range(Find_Item As Variant, _
Search_Range As Range, _
Optional LookIn As Variant, _
Optional LookAt As Variant, _
Optional MatchCase As Boolean) As Range

'this function has been downloaded at OZGrid.com

Dim c As Range
If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
If IsMissing(LookAt) Then LookAt = xlWhole 'xlPart
If IsMissing(MatchCase) Then MatchCase = False

With Search_Range
Set c = .Find( _
What:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
SearchFormat:=False)
If Not c Is Nothing Then
Set Find_Range = c
firstAddress = c.Address
Do
Set Find_Range = Union(Find_Range, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Function

 

[FJ]

Hi, Carlo, I'm sorry it's taken me so long to give you feedback on your
macro. I ran it and some of the results were correct, others were not. I
was trying to find a pattern as to which ones were correct and which were
not, but I couldn't. Here is an example of what happens:

Starting data:
ABCDE12320710 ABCDE12320719 Doe, Jane
ABCDE12320720 ABCDE12320720 Doe, Jane
ABCDE12320721 ABCDE12320733 Doe, Jane
ABCDE00376584 ABCDE00376584 Doe, John
ABCDE00376585 ABCDE00376596 Doe, John
ABCDE00376597 ABCDE00376597 Doe, John

Resulting data:
ABCDE12320710 ABCDE12320733 Doe, Jane
ABCDE00376584 ABCDE00376584 Doe, John
ABCDE00376585 ABCDE00376596 Doe, John
ABCDE00376597 ABCDE00376597 Doe, John

Resulting data should be:
ABCDE12320710 ABCDE12320733 Doe, Jane
ABCDE00376584 ABCDE00376597 Doe, John

So it consolidated the Jane Doe entry correctly but not the John Doe entry.

Also, this particular macro took a very long time to run. I'm not sure
exactly how long, as I let it run and went and did other things, but it might
have been about an hour and a half. Please don't take this as a criticism.
You just said you wanted feedback that's the only reason I mention it.
This particular file is one of the larger ones, like over 60,000 rows. Maybe
the file size and the speed/amount of memory in the computer has something to
do with.

Anyway, once again I really appreciate all your help. I've been using the
other macros you created to help automate the work on other files and they
work great. You have already saved me so much time.

If this latest macro is too much of a pain to modify I completely
understand. I really don't want to take up any more of your time with this.
I really appreciate all the help you've given me.

 

[carlo]

Hi FJ

I forgot one tiny little thing. Could you check this for me:
everytime the problem happens, are leading zeros involved, right?
for example: ABCDE00012345
i didn't see that coming, replace this function:
'----------------------------------------------------
Function returnConnection(strValue As String, Plus As Boolean) As
String

Dim a As Double
Dim c As Double
Dim b As String

For i = 1 To Len(strValue)
If IsNumeric(Mid(strValue, i, 1)) And Mid(strValue, i, 1) > 0 Then
a = CDbl(Right(strValue, Len(strValue) - i))
b = Left(strValue, i)
If Plus Then
c = a + 1
Else
c = a - 1
End If

If Len(c) <> Len(a) Then
b = Left(b, Len(b) - (Len(c) - Len(a)))
End If
returnConnection = b & c
Exit For
End If
Next i

End Function
'----------------------------------------------------

end for the speedproblem...i forgot to put in following pieces of code
at the beginning and end of sub main, directly after the sub main()
and before the sub end.
beginning:
'----------------------------------------------------
Dim Var_Calc As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Var_Calc = Application.Calculation
Application.Calculation = xlCalculationManual
'----------------------------------------------------

end:
'----------------------------------------------------
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = Var_Calc
'----------------------------------------------------
End Sub

tell me if it stills uses that much time.

Cheers Carlo

 

[FJ]

Hi, Carlo, I think you are right about the other macro. It does seem as
though the problem happens on entries with leading zeros. Good catch.

Anyway, I made the changes to the code that you indicated and got some
interesting results. Sometimes it gives a "Run-time error 13 type mismatch"
error and sometimes it gives a "Code execution has been interrupted" error
message. When I get the "Code execution has been interrupted" message if I
click "Continue" then I get the "Run-time error 13 type mismatch".

I know it's hard for you to reproduce these errors because you don't have
the same exact data as I do. I tried to find a pattern as to what entries
were correct and the ones that were incorrect, but I'm just not sure. It
seems as though it mostly did the ones with a few leading zeros correctly,
but not in all cases. For instance, it seemed to consolidate a group with
two leading zeros correctly but another group had three leading zeros and the
entries were not consolidated. And then it seemed to stop completely when it
got to an entry that started with seven leading zeros.

But then on a worksheet with different data, it did seem to consolidate the
data with three leading zeros correctly. But there were other errors and the
same error messages as above.

I guess it's also possible that I pasted something from the new code into
the wrong place in the existing code, although I think I put the pieces in
the right place.

Something else interesting that I noticed is that after I run the macro the
calculation option setting changes from "automatic" to "manual".

Anyway, as usual, I want to thank you for all your help. If you're tired
of modifying this macro I totally understand. The project we've been working
on is winding down (I hope) and we can finish the rest of the files manually
if we have to. I think the bulk of the work has already been done. I just
hate to take up any more of your time with this. You've saved me so much
time already that doing the last bit by hand won't be bad at all.

 

[carlo]

Hi, Carlo, I think you are right about the other macro. It does seem as
though the problem happens on entries with leading zeros. Good catch.

Anyway, I made the changes to the code that you indicated and got some
interesting results. Sometimes it gives a "Run-time error 13 type mismatch"
error and sometimes it gives a "Code execution has been interrupted" error
message. When I get the "Code execution has been interrupted" message if I
click "Continue" then I get the "Run-time error 13 type mismatch".

I know it's hard for you to reproduce these errors because you don't have
the same exact data as I do. I tried to find a pattern as to what entries
were correct and the ones that were incorrect, but I'm just not sure. It
seems as though it mostly did the ones with a few leading zeros correctly,
but not in all cases. For instance, it seemed to consolidate a group with
two leading zeros correctly but another group had three leading zeros and the
entries were not consolidated. And then it seemed to stop completely when it
got to an entry that started with seven leading zeros.

But then on a worksheet with different data, it did seem to consolidate the
data with three leading zeros correctly. But there were other errors and the
same error messages as above.

I guess it's also possible that I pasted something from the new code into
the wrong place in the existing code, although I think I put the pieces in
the right place.

Something else interesting that I noticed is that after I run the macro the
calculation option setting changes from "automatic" to "manual".

Anyway, as usual, I want to thank you for all your help. If you're tired
of modifying this macro I totally understand. The project we've been working
on is winding down (I hope) and we can finish the rest of the files manually
if we have to. I think the bulk of the work has already been done. I just
hate to take up any more of your time with this. You've saved me so much
time already that doing the last bit by hand won't be bad at all.














- Show quoted text -

Hi FJ

hmm....that would be a lot of guess working.

As I am rather busy right now I don't think, that i can up with a
clean solution for you.

If you could do it manually that would be great.
(I'm not tired of this, i'm actually still interested in why it
doesn't work!)

I don't think I could work on this problem until tuesday or even
wednesday.
I will definitely have another look at it then.

Sorry for that.

Cheers Carlo

 

[FJ]

Hi, Carlo, if you want to keep working on it that would be great. I would
be very interested in finding out what the solution is. Would it be helpful
if I sent you one of the files I've been experimenting with? That way you
would have a real example of what these letter/number combinations are like.
Just let me know. Thank you so much for your continued perseverance in this.