PDA

View Full Version : Database/List Manipulation



DarinM
06-11-2015, 08:41 AM
13663

Hi all,

I have a very very large list that I need edited, and I don't think IF statements are going to cut it!

I have attached an example spreadsheet to show you possibly better than I can explain it.

Column B has account #s, they are always different, sometimes the same but then a dash number would be different. Example below
012345-000
012345-001

Column C has company names, generally all the same. Example below
ABC Shop
ABC shop

Column D has address 1 - this is where I need help. This can be different or be the same. Example below
012345-000 ABC Shop 123 Fake Street
012345-001 ABC Shop 123 Fake Street

OR

012345-000 ABC Shop 123 Fake Street
012345-001 ABC Shop 456 Fake Street

Column E has Address 2 - generally used for PO boxes or suite/rooms
STE 204
STE 204

or

STE 204
STE 402

I would like Column F, G, H, become "extra account #'s", but they would only be used if the name, address 1 and address 2 were the exact same.

However, each column F,G,H would have to be organized based on Column J.

Column J has different price classes
0000 = normal pricing
0004 = discount pricing
5001 = government pricing

So if Row 3 were the same as Row 2, the spreadsheet would put Row 3's account # into column G because it gets discount pricing, based on the comparison of column J.

It would be extremely helpful and basically required, that if after matching between Row 2 and Row 3, Row 3 would be deleted.

Is this even possible, or should i do everything manually?

Appreciate your comments and suggestions

SamT
06-11-2015, 12:45 PM
So each company can have up to three accounts depending on the pricing level.
A company is defined by the company name and the complete address
Is not the customer also defined by the first 6 digits of the account number?

Would there ever be two companies with the same first 6 digit account number


012345-000

ABC Shop

123 Fake Street



012345-001
ABC Shop
234 Next Street
STE H



Finally, think about this and consider that it might work better for you



Account #

Company Name
Address 1
Address 2
Norm Pricing
Discount Pricing
Government Pricing


012345

ABC Shop
123 Fake Street
STE 204
012345-000

012345-001


056789
DBC Shop
425 Fake St

56789-002



051256
DEF Shop
100 Street

51256-005

DarinM
06-11-2015, 01:31 PM
hi Sam,

thanks for replying.

Yeah, up to 3 in this example but in reality it could be 15 classes, we are looking at increasing it to have a better database and filter-ability (is that a word?). However if I get help with 3 I can adapt the code to the other 15 or however many we will end up at.

The first 6 digits are the BILLTO, the next 3 are the SHIP to. However addresses can be the same or different and that is what makes it tricky. Sometimes the companies have a headoffice where it's billed, but shipped to their separate companies.

so yes your 000 and 001 example of same first 6 digit and different addresses can happen. that is a preferred situation, it's when they are the same is what is annoying and would like them on 1 line instead of 2.

As for your chart, it would work, I was just brainstorming with a coworker and they brought up another obstacle. But to continue with your chart idea, I always look at the main 6 digits, then look for the price class (level). So i would look for 012345 then shoot my eyes across to 0000 or 0004. so your method would work. I would look for the first 6 digits, then for the norm, discount or government column to see the dash 000 or 001 etc.

my coworkers obstacle is that, sometimes the account numbers can be 012345 and 234567 but they have the exact same company name and address 1/2. so I would also want that in the same row, but now what do we do if we have 2 or more account #'s with price class (level) of 0000?

Is it possible to have those account #s in 1 row, but ALT+Entered into a cell? so if you click on the cell, they are on separate lines, but in the same cell.

I hope that made sense. I have tried to adapt your table to visually show what I mean.






Account #

Company Name
Address 1
Address 2
Norm Pricing
Discount Pricing
Government Pricing


012345
234567
ABC Shop
123 Fake Street
STE 204
012345-000
234567-000
234567-002
012345-001
234567-001


056789
DBC Shop
425 Fake St

56789-002



051256
DEF Shop
100 Street

51256-005














I have attached a real sample from my database to show you.

SamT
06-11-2015, 02:47 PM
Jumpin' Jehosephat! How can one company have that many account numbers?

Not my business. Anyway I recommend three database on 3 separate sheets, named accordingly.



Main DataBase, AKA Bill To








Account #
Company Name
Address 1
Address 2
fistname
LastNamee
Phone
Notes


12234
ABC Shop
123 Fake Street
STE 204






56769
ABC Shop
123 Fake Street
STE 204


























Ship To DataBase








Account #
Company Name
Address 1
Address 2
fistname
LastNamee
Phone
Notes


12234-001
ABC Shop
123 Fake Street
STE 204






12234-002
ABC Shop
234 Nexte Street







56769-002
ABC Shop
123 Fake Street
STE 204
















Price DataBase








Account #
Type








012345-000
Normal








012345-001
Government








234567-000
Normal








234567-001
Government








234567-002
Discount








51256-005
Normal








56789-002
Discount









For business advice from a bunch of really nice guys and girls, try this place: BreakTime 3 (http://forums.delphiforums.com/breaktime_3/start)

mperrah
06-11-2015, 04:05 PM
13669
what about something like this
so every possible value can be accounted for in one row per customer?
2 (or more) values for Acct, 2 shipto, 2 billto, 2pricing per 3 types, etcs
that way you can populate as much as is needed

DarinM
06-15-2015, 06:48 AM
Hi Sam,

I know - it's insane. Partially the problem because our CRM was created in Germany for their database, which only has one account # and one pricing. The USA has the same database, and way less discounts. I am in Canada where we have 'free' healthcare or heavily discounted, hense all the -000's. However, some clinics have different accounts for different purchases, which I think is insane, because we are doing their accounting for them...but whatever haha. This is why I am trying to manipulate the exported data into something a bit more useful for my department.

I believe everything on 1 line would be much better because eventually when I do v-lookups to edit this database, i won't be able to do that as well with different tabs. Also, I'll be using this list from a marketing perspective where I need their e-mail addresses and different mailing addresses.

I will see if that would be useful but I am slightly skeptical :(.

Mperrah,

that is what I envisioned, except yours looks a bit redundant? Instead of account 1/2/3/4, and listing the same account # in the pricing columns, why wouldn't we just put the 'main' (whatever we determine is the main) in account 1, then all the rest account #s into the pricing columns? again this is really only for the accounts that have the same mailing address.

There may only be ~50-75 accounts that have different account #s, with different pricing with same mail address, but there are 1000's of same account #s but with different pricing. Almost every account will have 3 pricing accounts, regular, discounted and government.

012345-000 , -001, -004 etc.

Does that make anymore sense?


edit - also to note, the database where I am exporting this from - gets updated if not daily, then weekly. so whatever we do, having a way to export and then re-organize it into this fashion is the most important part, but we can look at that later, figuring out what the layout will be and seeing if we can copy values into certain columns then deleted the row we just copied from is a starting point...!

Darin

mperrah
06-15-2015, 09:33 AM
I was just suggesting for future proofing your layout by accounting for any future additions now.
It sounds like you have some companies with multiple account numbers and multiple extensions (pricing groups)
I thought having a place for each item would allow all info for each company to be on one line, I thought that was the goal.
I suggested each item could have 2, 3 or 4 entries available knowing some may be not used,
if you have a place for everything makes it easier to program (vlookup and others)

I would look at all the variables for the company with the most added parts and plot your data around that.
You may even consider having each part of the company ID be sectioned
first six unique company, 2nd two number shipping preference, 3rd two numbers bill to preference, last 2 pricing structure
Like SamT was pointing out. then you can have a library sheet with the named ranges for each category tp pull from.

If this whole project is to decide pricing, bill to, and ship to, having the ID numbers hold that info I think might streamline this process.
just a suggestion

DarinM
06-15-2015, 09:45 AM
That is true, having some empty columns before the rest of the information would work fine. Account #1 - 6 maybe, then the rest as discussed.

The whole project is to make an easier managed mailing list and e-mail mailing list, based on account #s without having to remove duplicates etc. Right now it's a very big tedious effort 3-4 times a year and figured I would be able to get some help coding a quicker fix. (longer initial start up obviously, then faster in the long run).

We agree to your option mperrah, it does make the most sense for us.

Do you have a starting template that I can try and edit?

snb
06-15-2015, 10:32 AM
I'd suggest:


Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion.Resize(, 10)

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
c00 = Split(sn(j, 2), "-")(0) & "_" & sn(j, 3) & "_" & sn(j, 4)

If .exists(c00) Then
sp = .Item(c00)
Else
sp = Application.Index(sn, j, Array(1, 2, 3, 4, 5, 6, 7, 8))
End If
sp(Application.Match(sn(j, 10), Array("0000", "0004", "5001"), 0) + 5) = "'" & sn(j, 10)

.Item(c00) = sp
Next

Sheet2.Cells(1).Resize(.Count, 8) = Application.Index(.items, 0, 0)
End With
End Sub

DarinM
06-15-2015, 10:56 AM
I tried that in the example excel I gave you, and it didn't do anything...added one more row to the top and mismatched.

mperrah
06-15-2015, 11:11 AM
Start with something like this setting up variables for each part of the Account number by section (name, discount, bill to, ship to anything else you need to designate)
13691
Then you can produce a unique Account ID that is meaningful
13693

snb
06-15-2015, 11:18 AM
I tried that in the example excel I gave you, and it didn't do anything...added one more row to the top and mismatched.

You can't be serious. :)
Look in sheet2.

Or in the attachment.

mperrah
06-15-2015, 11:52 AM
Not to throw a monkey wrench in this whole thread, but I re-read your first attached example.
This code will look for matching account numbers (first 6 numbers) then adds that number to the row above in the pricing column,
then removes the duplicate and moves to next, going from bottom up...
Sorry I didnt pursue this earlier.

Sub combineShops()
Dim x, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = lr To 2 Step -1
If Left(Cells(x, 2), 6) = Left(Cells(x - 1, 2), 6) Then
Select Case Cells(x, "J").Value
Case "0000"
Cells(x - 1, "F").Value = Cells(x, 2).Value
Case "0004"
Cells(x - 1, "G").Value = Cells(x, 2).Value
Case "5001"
Cells(x - 1, "H").Value = Cells(x, 2).Value
End Select
Cells(x, 2).EntireRow.Delete
End If
Next x

End Sub

DarinM
06-15-2015, 11:54 AM
Mperrah, that was suggested by my co-worker too, I suppose we could do a unique ID, except that will only be useful when referring to this document, everything else is based on account #.

Snb - wow, that was a fail on my part!

I like it, however in the government pricing column, it would have to put the -xxx number, not the 5001 number.

so 012345-001 would put -001 in the government pricing column instead of 5001. The -xxx number can be different, but it will always be classified as a certain account based on its price class column.

If you can make that change then i'll take a look at your old code vs new and see if I can spot the differences. My real export data has maybe 30 columns, so I will have to adapt your code into that and make sure it copies over the entire thing.

baby steps.. :)

DarinM
06-15-2015, 11:59 AM
Not to throw a monkey wrench in this whole thread, but I re-read your first attached example.
This code will look for matching account numbers (first 6 numbers) then adds that number to the row above in the pricing column,
then removes the duplicate and moves to next, going from bottom up...
Sorry I didnt pursue this earlier.



Just saw this, will try, give me a sec!

That works, but can you put the exported data into Sheet 2 like snb did?

I am thinking, it deleted the price code so I can't see if it worked (it looks like it did, but I would like to compare).

hope that is not difficult. I like that code though, it's doing what I want.

mperrah
06-15-2015, 12:12 PM
This just copies the last 3 of shop number

Sub combineShopsLast3()
Dim x, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = lr To 2 Step -1
If Left(Cells(x, 2), 6) = Left(Cells(x - 1, 2), 6) Then
Select Case Cells(x, "J").Value
Case "0000"
Cells(x - 1, "F").Value = Right(Cells(x, 2), 3)
Case "0004"
Cells(x - 1, "G").Value = Right(Cells(x, 2), 3)
Case "5001"
Cells(x - 1, "H").Value = Right(Cells(x, 2), 3)
End Select
Cells(x, 2).EntireRow.Delete
End If
Next x

End Sub

mperrah
06-15-2015, 12:18 PM
This leaves the rows that will be deleted and adds "Will Be Deleted" in column "K"
then adds the values in the pricing columns so you can see what changes

Sub combineShopsLast3()
Dim x, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = lr To 2 Step -1
If Left(Cells(x, 2), 6) = Left(Cells(x - 1, 2), 6) Then
Select Case Cells(x, "J").Value
Case "0000"
Cells(x - 1, "F").Value = Right(Cells(x, 2), 3)
Case "0004"
Cells(x - 1, "G").Value = Right(Cells(x, 2), 3)
Case "5001"
Cells(x - 1, "H").Value = Right(Cells(x, 2), 3)
End Select
'cells(x, 2).entirerow.Delete
Cells(x, "K").Value = "Will be Deleted"
End If
Next x

End Sub

DarinM
06-15-2015, 12:30 PM
Gotcha. I like keeping the entire account #, and the will be deleted, I modified your first code with your second :).

Ok so not sure if this is another wrench, but we could have different account #'s, same price class, same address... we would need a few columns like "normal pricing 1, 2, 3" etc. it doesn't happen often, but it could.

I suggested the ALT+Enter method, so you would have 5 account #'s in 1 cell, but that does not work for sorting (useful part of a database).

Ideas?


I seriously appreciate your help with this!

mperrah
06-15-2015, 01:17 PM
could you attach another sample worksheet,
that helps me code for all scenarios
take last years raw data from the source and remove any proprietary or sensitive stuff.
leave 40 to 50 rows if possible so we can get a good batch of possible combinations.
Or you can make fake data but keep its formatting the same so we can see how it all fits together

mperrah
06-15-2015, 01:20 PM
re post #18
maybe add an if statement in the loop so If account doesn't match but address does, combine those ?

DarinM
06-15-2015, 01:32 PM
re post #18
maybe add an if statement in the loop so If account doesn't match but address does, combine those ?
they would have to be in separate columns, can't combine...the filter search would be useless, it would be 00000-xxx00000-xxx.
it would have to check against itself I guess and then add into the next open pricing slot, if duplicates.

please see attached, that is a direct export, got rid of some content but left the columns as it really would be

also to note, we have 49 pricing codes, but only 5 are frequently used, so once we get this going, I would add the remainder on the end of the columns for the rare use that they would show up. wont worry about that.

snb
06-15-2015, 01:54 PM
On your request:

Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion.Resize(, 10)

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
c00 = Split(sn(j, 2), "-")(0) & "_" & sn(j, 3) & "_" & sn(j, 4)

If .exists(c00) Then
sp = .Item(c00)
Else
sp = Application.Index(sn, j, Array(1, 2, 3, 4, 5, 6, 7, 8))
End If
sp(Application.Match(sn(j, 10), Array("0000", "0004", "5001"), 0) + 5) = "'" & sn(j, 2)

.Item(c00) = sp
Next

Sheet2.Cells(1).Resize(.Count, 8) = Application.Index(.items, 0, 0)
End With
End Sub

mperrah
06-15-2015, 02:07 PM
ok, So what if we run the script to combine all matching company numbers and remove the duplicates,
then start another pass that then checks for duplicate addresses

where would this account number get moved too?

add a new column at the end of the row?

or insert a new one next to the pricing type (Normal/Discount/Gov)

If you know in advance how many duplicates there will be we can format the sheet prior to running the script and have the pricing data adjacent,

If you wont know how many duplicate address' may occur we can add a new column to the end of the row, regardless of how many.
I like being able to account for all possible situations, your RealSample is laid out different then I expected,
If you know what needs to go where we can help with the heavy lifting.

DarinM
06-16-2015, 08:01 AM
On your request:

hmm, that organizes it nicely yes, but it doesn't remove the duplicated (or show that it will remove duplicate addresses). I still see 10025 106th street 3x, with 3 different account #s, if that were on 1 line then yeah that would be good.



ok, So what if we run the script to combine all matching company numbers and remove the duplicates,
then start another pass that then checks for duplicate addresses

where would this account number get moved too?

add a new column at the end of the row?

or insert a new one next to the pricing type (Normal/Discount/Gov)

If you know in advance how many duplicates there will be we can format the sheet prior to running the script and have the pricing data adjacent,

If you wont know how many duplicate address' may occur we can add a new column to the end of the row, regardless of how many.
I like being able to account for all possible situations, your RealSample is laid out different then I expected,
If you know what needs to go where we can help with the heavy lifting.

Yeah that is what I am basically looking for.
Do you mean matching company numbers (account #s) that the first 6 digits are the same, then the only difference is the last 3? 123456-001, 123456-002?

Ok – just accounted for all possible situations, I have formatted the realsample attachment to look like how I think it should. I have also attached the totals of the price classes (you can see if the real sample too, but may be easier to see in the smaller attachment).


To help explain, '0000' is the code, 'List price' is the description of the code, and '14' is the number of duplicates, so we would need List price 1, 2,3,4,5,6 all to 14. So 14 columns. Which I have already done in the excel RealSample. Having that many columns isn't annoying to be honest, because all the vital information is before the first List Price 1, then once you see that information, you can scroll right to the price class account you're looking for! I like it!




0000
List price

14




And just to explain why there is 14, is that we have a buying group that helps out customers, so all the buying goes through one address. I would of set it up differently, but before my time!

Hope that helps to explain more and give you a better base to start some of that heavy lifting you were offering !
If it’s a lot of work to code each of the 33, just do a few of each and I can look at how to do the rest…that is a lot of redundant work lol.

Thank you so much again!

edit - just updated price class code.xls at 11:09EST, if you opened it before then, please re-download and open! thx

snb
06-16-2015, 08:13 AM
You might have noticed that the data are very inconsistent. That explains that superficially 'identical' adresses are in fact different (check for spaces !!).


I still see 10025 106th street 3x, with 3 different account #s, if that were on 1 line then yeah that would be good.

I don't, because the file you uploaded doesn't contain any.

DarinM
06-16-2015, 08:35 AM
ok, so you're segregating them correctly but not on 1 line.



A
091001-000
company ABC
10025 106TH ST
STE 105A






12
Alberta
10
West















5001
HCCI (DVA, NIHB)


091001-000




A
101542-000
company ABC
10025 106TH ST
STE 105A






12
Alberta
10
West















5
WCB alberta




101542-000


A
001001-000
company ABC
10025 106TH ST
STE 105A






12
Alberta
10
West















0
List price
001001-000







should look like



Status
Account
Company
Company 2
Address 1
Address 2
City
PC
PR
Lattitude
Longitude
Accuracy Level
TE
TE Description
Region
Region Description
Phone Number
Fax
Website
Email
Sales Channel
Sub-Channel
Class
IFA
DUNS
Manufacturers




Price Class
Price Class Description
List price
WCB BC
HCCI (DVA, NIHB)
WSIB ONTARIO
WCB alberta


A
091001-000
company ABC
10025 106TH ST
STE 105A






12
Alberta
10
West















5001
HCCI (DVA, NIHB)
001001-000

091001-000

101542-000




--

however, will this code take into account my last post about 14 list prices, etc?

mperrah
06-16-2015, 08:49 AM
As snb said, your data on RealSample is very inconsistent.
Many of the address values have an extra space in random areas, usually between the street name and suffix (Rd, St etc)
This will make finding matches near to impossible.

Also, you have 14 columns for list price, but your data leaves no indication which column it should go in?
How do we know if its listprice 1 or listprice 14?

and what does the last 3 digits of the account number signify?
they don't seem to correspond to the price list

mperrah
06-16-2015, 08:54 AM
re post #25 from snb,
his code worked for me, quite elegant.
data output to sheet2, added a fix for extra spaces throughout the address list,
added columns to the right and has the duplicate company items added there. nice work

about the error, be sure you have a sheet named "Sheet2" maybe

DarinM
06-16-2015, 09:01 AM
That's true I did not notice it, but like you say, some dashes, extra spaces etc. I think we could go through that and make them all the same. Do you propose a sem-automatic way of doing it? I noticed in snb's code he had "- " to "-", etc.

Assuming everything is the exact same, then we can find matches.

There are only a few accounts that will need all 14, and the order is not of any importance, just need them to go into 1 slot, assuming start at 1 and if empty, put it in, etc.

The last 3 digits are ship-to accounts. So sometimes you can have 123456-001,002,003. 001,002,003 are usually different addresses.



100424-002
company ABC

2300 EGLINTON AVE W
STE 401


100424-003
company ABC

515 PARK RD N
UNIT # 3




edit - also just checked more data, and more of them seem to be exact matches than not, so it may not be a huge issue (I realize it still is one).



re post #25 from snb,
his code worked for me, quite elegant.
data output to sheet2, added a fix for extra spaces throughout the address list,
added columns to the right and has the duplicate company items added there. nice work

about the error, be sure you have a sheet named "Sheet2" maybe
Yeah I had to re-open it, something messed up when I opened and saved. I replied with post #26, it is great, except not all on one line, like the comment you are inquiring about. (importance of which account goes into which slot of list price 1-14)

snb
06-16-2015, 09:50 AM
I think this what you are looking for.

mperrah
06-16-2015, 09:52 AM
Next step is to sort snb's sheet2 by address1 and do another combine of account numbers by matching address.

mperrah
06-16-2015, 10:47 AM
another question,
on the first pass we consolidate companies by account number regardless of address, loosing them (address) in the process
edit: an address match was part of the first pass...

Maybe we should sort and combine by address first,
then combine the account number / pricing structure and find a way to keep the alternate address,
in designated new column perhaps (to the right, as snb did for the account combining)

DarinM
06-16-2015, 11:01 AM
Hmm, getting there.

So my steps were, open the document, open developer vba, ran the code, looked in Sheet2, created a button, assigned the macro, filtered Address 1 A-Z, ran the code.

Now, when I filter by Address1, it still shows two 0000's and a 5001, I thought it would delete it? (or notify me that it would be deleted like a previous version of code)



A
100704-001
company ABC
10324 152A ST
0000


A
101121-001
company ABC
10324 152A ST
5001


A
101154-000
company ABC
10324 152A ST
0000




End result would still want to be 1 line though, so those 3 would be 1, but put into their proper columns..



another question,
on the first pass we consolidate companies by account number regardless of address, loosing them (address) in the process
if this is a mailing / emailing address function wont that defeat part of the purpose?
Maybe we should sort and combine by address first,
then combine the account number / pricing structure and find a way to keep the alternate address,
in designated new column perhaps (to the right, as snb did for the account combining)
or are the multiple address irrelevant?

I might be a bit confused.

If the address is the same for any accounts, consolidate on 1 line. (consolidate meaning, find the other account #'s with same address, and put into the applicable column based on price code)
If the address is different than any other account then it can stay on a line by itself.

One objective of this is for direct (snail) mailing promo's out to our customers, if we have 15 accounts with the same address, then we only need to send 1 promo out, except it would appear right now that we need to send 15.
Second objective of this is for e-mailing promos out to our customers, if we have 15 accounts with the same address, then the emails will be the same also, (I export these emails and will put into this database at a later time).
- side note for emails, depending on the input, maybe 1 of 15 accounts has an email associated with it, so if we picked #4 of 15, there may not be an email there, so if this was all on 1 line, they would have an email associated with it, even though it was only entered for 1 account.
- I can then backwards import those emails/contact names back into the database where I exported this, and it's up to date, so all 15 will have the same info.

Does that clarify? I didn't notice snb's code deleting anything, but if it does, then yes it is not useful in this application.

snb
06-16-2015, 11:48 AM
With the method I use it is impossible to get ''doubles'. If they seem identical it's because of sloppy data (cheack for spaces. invisible code, etc.).

If identicalness is defined by company name & company address1 only: see the attachment.

DarinM
06-16-2015, 12:23 PM
Ok yeah the duplicate I saw is now gone with that new code.

However - I have no idea how to edit that code to work with the realsample I attached this morning. I would like to match up 33 price classes, and input them into the appropriate columns like you have done. are you able to comment in the code 'this is where your price classes are matched

etc?

i'm so out to lunch with this unfortunately.

identicalness is defined by company address 1 actually, but when you added in company, the duplicate issue i found was gone.

edit - I can se like j,3 is taking from Company column, and.Item(sn(j, 32)) is the price class column.

if any combo of # is in there and matches, will it do what I want automatically?

I will want to put List price #1 in slot 1, list price #2 in slot 2, etc. - and do that type of sorting for all of my price classes as indicated in the price code attachment earlier too.

ive re-attached both

snb
06-16-2015, 12:31 PM
Did you try my code in your really real sample ?
It creates all different price classes automatically (provided they reside in column 32).

Take your time to study the code.
The more you understand the better you can use it.

DarinM
06-16-2015, 12:50 PM
Did you try my code in your really real sample ?
It creates all different price classes automatically (provided they reside in column 32).

Take your time to study the code.
The more you understand the better you can use it.

I did try now...

I am trying to understand a bit more, but not sure how it's going to work with the 1-14 like i said. I tried starting at column 10 which is the start of the first column 10 and doesn't work. I also tried with the end, and that also did not work..

run-time error '1004: application-defined or object defined error

doesnt highlight anything in the code




Sub M_snb()
Sheet1.Columns(5).Replace " ", " "
Sheet1.Columns(5).Replace "- ", "-"
Sheet1.Columns(5).Replace " -", "-"

sn = Sheet1.Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 3 To UBound(sn)
.Item(sn(j, 132)) = sn(j, 133)
Next
Sheet1.Cells(1, 10).Resize(, .Count) = .items
sq = .keys
.RemoveAll

sn = Sheet1.Cells(1).CurrentRegion

For j = 3 To UBound(sn)
c00 = sn(j, 3) & "_" & sn(j, 5)

If .exists(c00) Then
sp = .Item(c00)
Else
sp = Application.Index(sn, j, [transpose(row(1:133))])
End If
sp(Application.Match(sn(j, 132), sq, 0) + 133) = sn(j, 2)

.Item(c00) = sp
Next

Sheet2.Cells(1).Resize(, UBound(sn, 2)) = Sheet1.Cells(1).CurrentRegion.Rows(1).Value
Sheet2.Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
End With
End Sub




I also tried this, and switched them 1 for 1, and tried to see if they would add after column 133, still error




Sub M_snb()
Sheet1.Columns(5).Replace " ", " "
Sheet1.Columns(5).Replace "- ", "-"
Sheet1.Columns(5).Replace " -", "-"

sn = Sheet1.Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 3 To UBound(sn)
.Item(sn(j, 132)) = sn(j, 133)
Next
Sheet1.Cells(1, 134).Resize(, .Count) = .items
sq = .keys
.RemoveAll

sn = Sheet1.Cells(1).CurrentRegion

For j = 3 To UBound(sn)
c00 = sn(j, 3) & "_" & sn(j, 5)

If .exists(c00) Then
sp = .Item(c00)
Else
sp = Application.Index(sn, j, [transpose(row(1:133))])
End If
sp(Application.Match(sn(j, 132), sq, 0) + 133) = sn(j, 2)

.Item(c00) = sp
Next

Sheet2.Cells(1).Resize(, UBound(sn, 2)) = Sheet1.Cells(1).CurrentRegion.Rows(1).Value
Sheet2.Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
End With
End Sub

snb
06-16-2015, 01:04 PM
Use F8 to step through the code, to learn what it does and to provide detailed feedback.

DarinM
06-16-2015, 01:05 PM
error occurs at this point


Sheet1.Cells(1, 134).Resize(, .Count) = .items
sq = .keys

mperrah
06-16-2015, 01:43 PM
13712
This has the results of snb's macro relocated to the sheet you modified to house the data (sorted by address)
some address info has been modified to conform.
I just moved it manually for now, there are still the duplicates in the columns, but if this is the start of what you want I believe we can move forward.

SamT
06-16-2015, 01:56 PM
Hi Sam,

I know - it's insane. Partially the problem because our CRM was created in Germany for their database, which only has one account # and one pricing. The USA has the same database, and way less discounts. I am in Canada where we have 'free' healthcare or heavily discounted, hense all the -000's. However, some clinics have different accounts for different purchases, which I think is insane, because we are doing their accounting for them...but whatever haha. This is why I am trying to manipulate the exported data into something a bit more useful for my department.

I believe everything on 1 line would be much better because eventually when I do v-lookups to edit this database, i won't be able to do that as well with different tabs. Also, I'll be using this list from a marketing perspective where I need their e-mail addresses and different mailing addresses.

I will see if that would be useful but I am slightly skeptical :(.

Mperrah,

that is what I envisioned, except yours looks a bit redundant? Instead of account 1/2/3/4, and listing the same account # in the pricing columns, why wouldn't we just put the 'main' (whatever we determine is the main) in account 1, then all the rest account #s into the pricing columns? again this is really only for the accounts that have the same mailing address.

There may only be ~50-75 accounts that have different account #s, with different pricing with same mail address, but there are 1000's of same account #s but with different pricing. Almost every account will have 3 pricing accounts, regular, discounted and government.

012345-000 , -001, -004 etc.

Does that make anymore sense?


edit - also to note, the database where I am exporting this from - gets updated if not daily, then weekly. so whatever we do, having a way to export and then re-organize it into this fashion is the most important part, but we can look at that later, figuring out what the layout will be and seeing if we can copy values into certain columns then deleted the row we just copied from is a starting point...!

Darin

I see I left some confusion there.

Those suggested tables are not what you separate your incoming data into, rather they are permanent tables that only get updated when your client list changes.

Your incoming data would be processed against those lookup databases. The only pre-processing needed on the incoming data would be to split the account numbers on the "-" into 2 new columns (3 columns: Full Acctt#, 6 digit # and 3 digit suffix.

For Marketing purposes have an Email database.

According to the KISS Principle:
The accounting calculations only need to know the Full acct # and the Pricing Classification.
Only above that, do they need to know the Billing and Ship To addresses
Marketing needs to know the Email addresses.

I m sure that I left out a lot, but break your needs down that way.

I looked at your RealSample book, but I didn't see any Accounting figures in there, so I am still in the dark, or at least, Twilight about what you do and need. We here at VBAX have a combined total of hundreds of years experience in many different fields of business. Don't be afraid to ask for the best way to use Office to handle a particular business task. Someone will know.

mperrah
06-16-2015, 04:12 PM
DarinM,
I think snb was trying to say his code will look at all the different price types in the column and generate a new column at the end of the row for each type.

How you adjusted your sheet to accommodate the 33 types and the 100 variances is not necessary (and would change each quarter anyway I believe),
his code will do it with what you have in your raw data.

I think I see what you are talking about with 1-14. For same account numbers, with same address, same price type > if more than one match:
you need a separate column added for each (sometimes up to 14) and stay in same row.

snb: could you use/make a header with a unique name as an index to find the column for inserting the matches, and if not empty create an iterated copy List(i), WCB BC(i) etc
like:


fill array with unique price types = headernames
get match for account# and address then copy row
for x = lbound(headernames) to ubound(headernames)
if headernames(x) isEmpty then
paste matched.row there
else
insert column
cells(1, x +1).value = headername(x) & i
i = i +1
paste matched.row now

this is just an idea map to try coding, if you get the thought process??

snb
06-17-2015, 01:11 AM
In VBA
lesson 1: never use merged cells
lesson 2: avoid 'Select' and 'Activate'
lesson 3: avoid interaction with the workbook/worksheet as much as possible

Your file doesn't meet the criteria in lesson 1.

I think I provided all the information to answer your question.
Since the information you provided changed very often I think you best do the finetuning yourself.
If you prefer this commercial assignment to be developed further by me, you can use the paypal button in my website.
If I were your (not very poor) employer I'd prefer the latter.

PS. The inaccuracy/inconsistency of the data in your CRM-system baffles me.

DarinM
06-17-2015, 05:42 AM
13712
This has the results of snb's macro relocated to the sheet you modified to house the data (sorted by address)
some address info has been modified to conform.
I just moved it manually for now, there are still the duplicates in the columns, but if this is the start of what you want I believe we can move forward.

Yes that is exactly what I want, and just to reinforce ... when finished the 2 lines below, would become 1, and "102179-015" would be in list 2 column



A
090169-000
company ABC
1115-C AUSTIN AVE




000169-000


A
102179-015
company ABC
1115-C AUSTIN AVE




102179-015

DarinM
06-17-2015, 05:45 AM
DarinM,
I think snb was trying to say his code will look at all the different price types in the column and generate a new column at the end of the row for each type.

How you adjusted your sheet to accommodate the 33 types and the 100 variances is not necessary (and would change each quarter anyway I believe),
his code will do it with what you have in your raw data.

I think I see what you are talking about with 1-14. For same account numbers, with same address, same price type > if more than one match:
you need a separate column added for each (sometimes up to 14) and stay in same row.

snb: could you use/make a header with a unique name as an index to find the column for inserting the matches, and if not empty create an iterated copy List(i), WCB BC(i) etc
like:


fill array with unique price types = headernames
get match for account# and address then copy row
for x = lbound(headernames) to ubound(headernames)
if headernames(x) isEmpty then
paste matched.row there
else
insert column
cells(1, x +1).value = headername(x) & i
i = i +1
paste matched.row now

this is just an idea map to try coding, if you get the thought process??

Hi mperrah,

these wouldn't change each quarter, they're account #s and only rarely will they close, or new ones be opened. - if I understand your point correctly.

I would run this macro from an entire database dump, which would always include those 1-14, so having new code that would add columns in 'if empty', isn't really necessary. would be handy though.

DarinM
06-17-2015, 06:03 AM
In VBA
lesson 1: never use merged cells
lesson 2: avoid 'Select' and 'Activate'
lesson 3: avoid interaction with the workbook/worksheet as much as possible

Your file doesn't meet the criteria in lesson 1.

I think I provided all the information to answer your question.
Since the information you provided changed very often I think you best do the finetuning yourself.
If you prefer this commercial assignment to be developed further by me, you can use the paypal button in my website.
If I were your (not very poor) employer I'd prefer the latter.

PS. The inaccuracy/inconsistency of the data in your CRM-system baffles me.

I appreciate your help snb. It's almost there, your last file is doing what I want, minus accounting for the multiple 0000 price classes as I showed in the RealSample excel with 14 columns.

The inaccuracies baffle me too, I don't know how they are entered but I am assuming manually, or copy/paste directly from the clinics application. So if they decided to say 115-C fake street instead of 115C fake street, they just entered it. This system is so backwards and not how it should be designed. Apparently we are getting a 'new' one, but people have been saying that for years apparently. I'm 8 months fresh here.

My next task would of been to get rid of the inconsistencies based on postal code, then copy address 1 and paste over all the same postal code addresses to remove any differences. However I have just learned that we can't import a mass address change, so going 1 by 1 manually is just plain stupid. I could modify the addresses in excel then do this macro I was hoping to use.

I don't know VBA so I wouldn't know those lessons, nor did I see any merged cells, thanks for letting me know. Summer is a slower time for my department which is why I am trying to figure out how to streamline some broken manual processes for when it picks back up in the fall.

Thanks again.

SamT
06-17-2015, 08:58 AM
I went thru your RealSample and found 5 errors (typos) in the Address1 Column


Doublespaces
Dash errors (Assuming X-X is desired)

X- X
X -X
X - X


360 MAIN ST vs 360 MAIN ST E


In that small sample there were multiple instances of 25 distinct address1's with those errors.
I did not analyze Column Address2 but I did notice a RM 204 vs STE 204 error.

This is using the KISS Principle. It can be sped up using arrays for the OldString and the NewString


Sub FixTypos()

'With Application
'.ScreenUpdating = False
'.DisplayAlerts = False
'End With

With ActiveSheet
'Reset Parameters and replace doublespaces
.Cells.Replace What:=" ", Replacement:=" ", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:= _
False, ReplaceFormat:=False

.Cells.Cells.Replace What:=" -", Replacement:="-"
.Cells.Cells.Replace What:="- ", Replacement:="-"
.Cells.Cells.Replace What:="-", Replacement:="-" 'Style choice
.Cells.Cells.Replace What:="360 MAIN ST", Replacement:="360 MAIN ST E", _
LookAt:=xlWhole 'To avoid 360 MAIN ST EE

End With

With Application
.ScreenUpdating = True
.DisplayAlerts = True
'End With

End Sub

'Cells.Replace What:=OldString, _
Replacement:=NewString, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:= _
False, ReplaceFormat:=False



If you very many specific errors (like Main St E and RM vs STE, You may want to list the errors and corrections on a hidden sheet and create the Arrays from those lists.

DarinM
06-17-2015, 09:05 AM
I went thru your RealSample and found 5 errors (typos) in the Address1 Column


Doublespaces
Dash errors (Assuming X-X is desired)

X- X
X -X
X - X


360 MAIN ST vs 360 MAIN ST E


In that small sample there were multiple instances of 25 distinct address1's with those errors.
I did not analyze Column Address2 but I did notice a RM 204 vs STE 204 error.

This is using the KISS Principle. It can be sped up using arrays for the OldString and the NewString

If you very many specific errors (like Main St E and RM vs STE, You may want to list the errors and corrections on a hidden sheet and create the Arrays from those lists.

Thanks Sam, that will help me when the times comes!

There are a lot of errors indeed, which we do know about but sadly everyone goes "oh well". Until it affects them of course. It's now affecting me so I will try and fix on my end. The export will always have those issues because we can't import the changes in 1 lump file, don't get me started on why! haha

That is a secondary issue right now, my first would be to get the code working for my application, which I believe is almost there, but at a stand still... I have asked my boss if he wants to invest any $ and he didn't really give me an answer, I'd have to see how much it would cost to finish the code.

SamT
06-17-2015, 11:28 AM
The inaccuracy/inconsistency of the data in your CRM-system baffles me.
Data processing rule # 1: Clean up your data before trying to process it.

I don't offer ineffectual or unnecessary solutions. If you complete the code for all typos and run it on all incoming data. you will have consistent data. Your sample has almost 500 rows. I ran that code on the entire sheet and it was done literally in the blink of an eye and eliminated 25 of at least 26 duplicate sets of data. If you create a dictionary array list on a sheet as I suggest, it will very easy to maintain as new typos appear. Which they will.

DarinM
06-17-2015, 11:50 AM
I assume 98% of the data will be fine, and i'll work on fixing the inconsistencies - however without working code to do the rest, that part is useless. Unfortunately like I said, HQ can't batch import my changes, which makes this task quite tedious.

snb
06-17-2015, 12:00 PM
---- nor did I see any merged cells - - - -

So what about DV1:EA1 ?

DarinM
06-17-2015, 12:03 PM
So what about DV1:EA1 ?

Gotcha - didn't know that mattered in vba like I said. thanks for pointing that out

It isn't used for this situation but if its an issue we can unmerge, i won't be looking at those columns

SamT
06-17-2015, 12:32 PM
Unfortunately like I said, HQ can't batch import my changes, which makes this task quite tedious.

I don't understand the issue. Aren't you working on data that you will be processing at your own location? IIRC, you said that you received the dirty data from elswhere and were then rearranging/editing it for processing locally. If you don't mind my asking, what is your office's product?


I assume 98% of the data will be fine,
More like less than 82%. You have ~149 unique dirty record sets, but only ~122 unique clean record sets, in just that small sample of 470 records.

I have to use aproximations because I only looked at Address1.

DarinM
06-17-2015, 12:44 PM
We sell hearing aids.

We have a local CRM we update/pull from, however the people who can truly administer the background are in New Jersey.

Yeah that looks rougher than estimated, but like I said, that is the easier issue than not having a working macro :)

SamT
06-17-2015, 01:04 PM
the people who can truly administer the background are in New Jersey.
But we're not talking about "administering the background," are we? I was under the impression that this was all for your computer at your desk.


Yeah that looks rougher than estimated, but like I said, that is the easier issue than not having a working macro
Maybe from your viewpoint.

From my viewpoint as a programmer, it must be done before starting to write code to manipulate a data base..

snb
06-17-2015, 01:51 PM
It isn't used for this situation but if its an issue we can unmerge, i won't be looking at those columns

Thats isn't correct. How can VBA point to cells(1,134) if some cells in row 1 have been merged ?

SamT
06-17-2015, 02:01 PM
Data processing rule # 1: Clean up your data before trying to process it.

DarinM
06-18-2015, 05:44 AM
Thats isn't correct. How can VBA point to cells(1,134) if some cells in row 1 have been merged ?

Now I see why your point makes sense. Thank you.

DarinM
06-18-2015, 06:10 AM
Good morning

I got the code to partially work in my RealSample, however not starting at column 10 like intended, just at row 134 to 140.

I also noticed that one list price 0000 was deleted, there was 2 but only 1 was kept. That is what I need to avoid, need to keep both of them.

I will spend some time this morning cleaning up my RealSample data to make sure there are no errors.




A
100704-001
company ABC

10324 152A ST
0000


A
101121-001
company ABC

10324 152A ST
5001


A
101154-000
company ABC

10324 152A ST
0000




turned into





A
100704-001
company ABC
10324 152A ST
000122-000
090122-000



which is weird because I don't see 090122-000 in the original data under that address?

hmm..

mperrah
06-19-2015, 12:22 PM
Making progress,
this finds matches of the price type and copies the account number to the appropriate column,
I'm working on then copying each row "J to DE" up a row if the address matches, but it overwrites the contents, work in progress.
I have made a table with price types as they appear on the sheet in Row 1 and another as they appear in Column EC on Sheets("Pricing")
I have code that builds an array with the pricing values without the indexing numbers, not sure yet how to utilize both parts.
My thought is to copy up the values one row at a time and if the cell above is full, offset 1 to right...
not sure if im on the right track, but this at least gets the account number in the appropriate columns....
(I had to convert the values in Row 1 and column EC to uppercase)

Sub combineAccounts()
Dim x, lr As Long
Dim ws As Worksheet
Dim aPtype As Variant

Set ws = Worksheets("S1-var")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row

For x = lr To 3 Step -1

Set pFnd = .Range("I1:DE1").Find(Left(Cells(x, "EC"), Len(Cells(x, "EC")) - 3), , Excel.xlValues)
pFnd.Offset(x - 1).Value = Cells(x, 2).Value

Next x
'For p = lr To 3 Step -1
' If .Cells(p, "E") = .Cells(p - 1, "E") Then
' Range("J" & p & ":DE" & p).Copy Range("J" & p - 1)
' Cells(p, "D").Value = "To Delete"
' End If
'
'Next p

End With
End Sub13740

mperrah
06-19-2015, 12:54 PM
Ok, be patient. This code takes for ever, but it copies all the accounts across then copies them up and puts a "To Delete" in column "D"
if the cell above is occupied it moves over 1 top right for the copy.
Maybe the real gurus can modify this to speed up process.

Sub combineAccounts()
Dim x, lr As Long
Dim ws As Worksheet
Dim aPtype As Variant

Application.ScreenUpdating = False


Set ws = Worksheets("S1-var")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row

For x = lr To 3 Step -1
Set pFnd = .Range("I1:DE1").Find(Left(Cells(x, "EC"), Len(Cells(x, "EC")) - 3), , Excel.xlValues)
pFnd.Offset(x - 1).Value = Cells(x, 2).Value
Next x

For r = lr To 3 Step -1
For c = 10 To 109
If .Cells(r, "E") = .Cells(r - 1, "E") And _
Cells(r - 1, c).Value = "" Then
Cells(r, c).Copy Cells(r - 1, c)
Cells(r, "D").Value = "To Delete"
ElseIf .Cells(r, "E") = .Cells(r - 1, "E") And _
Cells(r - 1, c).Value <> "" Then
Cells(r, c).Copy Cells(r - 1, c + 1)
Cells(r, "D").Value = "To Delete"
End If
Next c
'Cells(r, c).EntireRow.Delete
Next r
End With
Application.ScreenUpdating = True
End Sub

DarinM
06-19-2015, 01:30 PM
Wow this is terrific! I love it, I am just about to leave the office and saw your thread reply. This is great, i will have to look it over monday... I don't mind it taking long if it works!

i just for fun uncommented your delete rows, r,c and entire thing got wiped lol

have a good weekend!

mperrah
06-19-2015, 02:58 PM
This seems to do it all, very slow, and test on a sample book - not original.

Sub combineAccounts()
Dim x, lr As Long
Dim ws As Worksheet
Dim aPtype As Variant

Application.ScreenUpdating = False

Set ws = Worksheets("S1-var")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row

For x = lr To 3 Step -1
Set pFnd = .Range("I1:DE1").Find(Left(Cells(x, "EC"), Len(Cells(x, "EC")) - 3), , Excel.xlValues)
pFnd.Offset(x - 1).Value = Cells(x, 2).Value
Next x

For r = lr To 3 Step -1
For c = 10 To 109
If .Cells(r, "E") = .Cells(r - 1, "E") And _
Cells(r - 1, c).Value = "" Then
Cells(r, c).Copy Cells(r - 1, c)
Cells(r, "D").Value = "To Delete"
ElseIf .Cells(r, "E") = .Cells(r - 1, "E") And _
Cells(r - 1, c).Value <> "" Then
Cells(r, c).Copy Cells(r - 1, c + 1)
Cells(r, "D").Value = "To Delete"

End If
Next c
Next r

For d = lr To 3 Step -1
If Cells(d, "D").Value = "To Delete" Then
Cells(d, "D").EntireRow.Delete
End If
Next d

End With

Application.ScreenUpdating = True

End Sub

13743

DarinM
06-23-2015, 05:25 AM
Thank you so much mperrah! I believe it is working great :)

One thing that may be useful, is to have another piece of code assigned to a separate button, that after we sort, we can delete the empty and unused columns, so that we don't need to scroll over useless/empty ones. The columns may or may not be full depending on the data we decide to export.

If that's too much to ask then I am still a happy camper!

Also, regarding the cleaning up the database, if we have to do it manually here, I'll be flagging all the accounts that are off by a bit and assigning people sets of data to fix. It'll be a one-time fix, and ill make sure going forward they copy/paste from the previous account address if another is to be added.

mperrah
06-23-2015, 01:03 PM
Deleting columns is pretty straight forward. You mean delete the pricing columns that have no values?
We can script that. Give me a few...

I am currently trying to speed up the macro I posted that is working.
I am at an impass, by my reasonging this should work, but it fails to copy over to the next blank column.
It runs much faster, but leaves out the accounts with multiple values in the same pricing structure. I'll keep on it unless someone else can see what I'm missing:
I tried to eliminate a few of the redundant loops through the data, but cant see where I'm flawed.

Sub combineAccounts_v2()
Dim lr, x, r, c, d As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Worksheets("S1-var")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row

For r = lr To 3 Step -1
Set pFnd = .Range("I1:DE1").Find(Left(Cells(r, "EC"), Len(Cells(r, "EC")) - 3), , Excel.xlValues)
pFnd.Offset(r - 1).Value = Cells(r, 2).Value

If .Cells(r, "E") = .Cells(r - 1, "E") Then
For c = 10 To 109

If .Cells(r, c).Value <> "" Then

If .Cells(r - 1, c).Value <> "" Then
Cells(r, c).Copy Cells(r - 1, c + 1)
Cells(r, "D").Value = "toDel"
ElseIf .Cells(r - 1, c).Value = "" Then
Cells(r, c).Copy Cells(r - 1, c)
Cells(r, "D").Value = "toDel"
End If

End If

Next c
End If
Next r

For d = lr To 3 Step -1
If .Cells(d, "D").Value = "toDel" Then
.Cells(d, "D").EntireRow.Delete
End If
Next d

End With

Application.ScreenUpdating = True

End Sub

mperrah
06-23-2015, 01:24 PM
If you needed the pricing columns that had zero entries removed, this should work:

Sub remEmptyCol()
Dim lr, r, c As Integer

Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row

For c = 109 To 10 Step -1
rCnt = 0
For r = lr To 3 Step -1
If Cells(r, c).Value = "" Then
rCnt = rCnt + 1
End If
Next r
If rCnt = lr - 2 Then
Cells(r, c).EntireColumn.Delete
End If
Next c
Application.ScreenUpdating = True
End Sub

This is the latest version of the main code I'm still trying to trim down.
It takes around 60 seconds on my machine...

Sub combineAccounts_v1b()
Dim x, lr As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Worksheets("S1-var")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row

For x = lr To 3 Step -1
Set pFnd = .Range("I1:DE1").Find(Left(Cells(x, "EC"), Len(Cells(x, "EC")) - 3), , Excel.xlValues)
pFnd.Offset(x - 1).Value = Cells(x, 2).Value
Next x

For r = lr To 3 Step -1
If .Cells(r, "E") = .Cells(r - 1, "E") Then
For c = 10 To 109

If Cells(r - 1, c).Value = "" Then
Cells(r, c).Copy Cells(r - 1, c)
Cells(r, "D").Value = "To Delete"

ElseIf Cells(r - 1, c).Value <> "" Then
Cells(r, c).Copy Cells(r - 1, c + 1)
Cells(r, "D").Value = "To Delete"
End If
Next c
End If
Next r

For d = lr To 3 Step -1
If Cells(d, "D").Value = "To Delete" Then
Cells(d, "D").EntireRow.Delete
End If
Next d

End With

Application.ScreenUpdating = True

End Sub

mperrah
06-23-2015, 01:36 PM
As far as scrubbing your data,
I used auto-filter under the "data" ribbon tab: it will combine matching entries and sort alphabetically.
so un-check "select all", and look for a close match then check those few and click "ok",
then edit as needed,
go back to filters, un-check those fixed entries,
look for a few more close entries, check them for editing and click "ok" again,
repeat till you're through the data.
It only took me a few minutes this way, but I'm not positive what entries can be combined where you should be.
The tricky part is Rm and Ste can be spread out alphabetically, as well as some have the Ste # before the street address...
Hopefully once these are fixed your reports should go much more smoothly.

mperrah
06-23-2015, 03:30 PM
Down to 8 seconds...

Sub combineAccounts()
Dim x, lr As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Worksheets("S1-var")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row

For x = lr To 3 Step -1
Set pFnd = .Range("I1:DE1").Find(Left(Cells(x, "EC"), Len(Cells(x, "EC")) - 3), , Excel.xlValues)
pFnd.Offset(x - 1).Value = Cells(x, 2).Value
Next x

For r = lr To 3 Step -1
For c = 10 To 109

If .Cells(r, "E") = .Cells(r - 1, "E") And _
Cells(r, c).Value <> "" And _
Cells(r - 1, c).Value = "" Then
Cells(r, c).Copy Cells(r - 1, c)
Cells(r, "D").Value = "To Delete"

ElseIf .Cells(r, "E") = .Cells(r - 1, "E") And _
Cells(r, c).Value <> "" And _
Cells(r - 1, c).Value <> "" Then
Cells(r, c).Copy Cells(r - 1, c + 1)
Cells(r, "D").Value = "To Delete"

End If
Next c
Next r

For d = lr To 3 Step -1
If Cells(d, "D").Value = "To Delete" Then
Cells(d, "D").EntireRow.Delete
End If
Next d

End With

Application.ScreenUpdating = True

End Sub