Macro to move stuff around (awesome title I know :P)

Y

youra6

Board Regular
Joined
Mar 31, 2014
Messages
95
I have a macro that lets me take a customer contact list and change it into this format. I initially thought this format would work well with index(match), but it doesn't.

Here is it:

[TABLE="class: grid, width: 1781"]
<tbody>[TR]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Walmart[/TD]
[TD]Name 1[/TD]
[TD]111-111-1111[/TD]
[TD]111-111-1112[/TD]
[TD]name1@email.com[/TD]
[TD][/TD]
[TD]Walmart[/TD]
[TD]Name 2[/TD]
[TD]222-222-2222[/TD]
[TD]222-222-2223[/TD]
[TD]Name3@email.com[/TD]
[TD][/TD]
[TD]Costco[/TD]
[TD]Name 3[/TD]
[TD]333-333-3333[/TD]
[TD]333-333-3334[/TD]
[TD]name3@gmail.com[/TD]
[TD]blah blah[/TD]
[/TR]
</tbody>[/TABLE]


This table continues in this format until column PV, and it subject to be longer as time goes on. For now, I only included the first 3 clients.

As you can tell, it follows a simple pattern. On every 7th column, it goes back to Client and loops the same column headers.

I want a Macro that turns the above table into this:

[TABLE="class: grid, width: 1327"]
<tbody>[TR]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Walmart[/TD]
[TD]Name 1[/TD]
[TD]111-111-1111[/TD]
[TD]111-111-1112[/TD]
[TD]name1@email.com[/TD]
[TD][/TD]
[TD]Walmart[/TD]
[TD]Name 2[/TD]
[TD]222-222-2222[/TD]
[TD]222-222-2223[/TD]
[TD]Name3@email.com[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Costco[/TD]
[TD]Name 3[/TD]
[TD]333-333-3333[/TD]
[TD]333-333-3334[/TD]
[TD]name3@gmail.com[/TD]
[TD]blah blah[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Everytime a new Client is introduced, it is given its own row (Costo is different from Walmart and Walmart).


I then can proceed to create a macro to delete the duplicate headers, so the end result would look like this and it would be way easier to do my index match formulas:

[TABLE="class: grid, width: 1327"]
<tbody>[TR]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[TD]Client[/TD]
[TD]Contact[/TD]
[TD]Phone # (Office)[/TD]
[TD]Phone # (Mobile)[/TD]
[TD]Email Address[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Walmart[/TD]
[TD]Name 1[/TD]
[TD]111-111-1111[/TD]
[TD]111-111-1112[/TD]
[TD]name1@email.com[/TD]
[TD][/TD]
[TD]Walmart[/TD]
[TD]Name 2[/TD]
[TD]222-222-2222[/TD]
[TD]222-222-2223[/TD]
[TD]Name3@email.com[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Costco[/TD]
[TD]Name 3[/TD]
[TD]333-333-3333[/TD]
[TD]333-333-3334[/TD]
[TD]name3@gmail.com[/TD]
[TD]blah blah[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
youra6,

In order to resolve your problem there are a couple of way that we can address the issue. First I will explain a few short portions of code and what they are doing. After that I will give you a few different way to touble shoot the issue on your system.

This line of Code Counts the Client Name in Row 2 (i.e. If Alliance Berstein appears 5 times our Variable CountArrayItem will be 5) :
Code: 
 CountArrayItem = Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(2, Columns.Count)), CustArray(i))

This block of code:
Code: 
[COLOR=#008000]   'Find First Instance of Client[/COLOR]
   [COLOR=#0000ff] With [/COLOR]Sheets("Macro Sheet").Range("B2:B" & Columns.Count)
      [COLOR=#0000ff] Set[/COLOR] Rng = Cells.Find(What:=CustArray(i), _
                       After:=Range("A1"), _
                       LookAt:=xlWhole, _
                       LookIn:=xlValues, _
                       SearchOrder:=xlByColumns, _
                       SearchDirection:=[COLOR=#ff0000]xlNext[/COLOR], _
                       MatchCase:=[COLOR=#0000ff]False[/COLOR])
[COLOR=#0000ff]    End With[/COLOR]
                  [COLOR=#0000ff]  If Not[/COLOR] Rng[COLOR=#0000ff] Is Nothing Then[/COLOR]
                    FirstAddress = Rng.Address [COLOR=#008000]'Variable is given value here[/COLOR]
looks in Row 2 for the Client Name going Left to Right (xlNext)and returns it's cell address (First Address). So if we had this example:

Excel 2012
ABCD
1HeaderHeaderHeaderHeader
2Alliance BersteinAlliance BersteinAlliance BersteinAlliance Berstein
Sheet1



It would return:$A$2
OffFirstAddress is simply one cell up ($A$1)
This block of code:
Code: 
[COLOR=#008000]   'Find Last Instance of Client[/COLOR]
   [COLOR=#0000FF] With [/COLOR]Sheets("Macro Sheet").Range("B2:B" & Columns.Count)
      [COLOR=#0000FF] Set[/COLOR] Rng = Cells.Find(What:=CustArray(i), _
                       After:=Range("A1"), _
                       LookAt:=xlWhole, _
                       LookIn:=xlValues, _
                       SearchOrder:=xlByColumns, _
                       SearchDirection:=[COLOR=#FF0000]xlPrevious[/COLOR], _
                       MatchCase:=[COLOR=#0000FF]False[/COLOR])
[COLOR=#0000FF]    End With[/COLOR]
                  [COLOR=#0000FF]  If Not[/COLOR] Rng[COLOR=#0000FF] Is Nothing Then[/COLOR]
                    LastAddress = Rng.Address [COLOR=#008000]'Variable is given value here[/COLOR]
does the opposite. It looks in Row 2 for the Client Name going Right to Left (xlPrevious)and returns it's cell address (Last Address). So if we had this example:

Excel 2012
ABCD
1HeaderHeaderHeaderHeader
2Alliance BersteinAlliance BersteinAlliance BersteinAlliance Berstein
Sheet1


It would Return:$D$2


So it really shouldn't matter how many contacts your have it should pick them all up.... (Is there a misspelling or a leading or trailing space in the data??)

The line of code does that you changed:
Code: 
  OffLastAddress = Range(LastAddress).Offset(, 5).Address

Offsets five cells to the right of LastAddress. So It is essentially getting the last cell in the copy range. OffLastAddress is simply 5 cells to the right ($I$2)

So in Our Example LastAddress finds:$D$2
So from $D$2 we go 5 cells to the right to encompass the Notes Field. Here is an illustration of where the variables would be.... :

Excel 2012
ABCDEFGHI
1OffFirstAddress ($A$1) HeaderHeaderHeaderClientContactPhone # (Office)Phone # (Mobile)Email AddressNotes
2FirstAddress (Alliance Berstein)Alliance BersteinAlliance BersteinLast Address (Alliance Berstein)OffLastAddress ($i$2)
Sheet1

In this line of code we use our variables to copy the range:
Code: 
Range(OffFirstAddress & ":" & OffLastAddress).Cut
So in our example this line would Cut: Range("$A$1:$I$2")

In order to debug or trouble shoot this code you will need to:

1. Go into the VBE and Access the Immediate Window (Ctrl + G)
2. add in Debug.Print statements after the variable is assigned.
For Example:
Code: 
             [COLOR=#0000ff] If Not[/COLOR] Rng[COLOR=#0000ff] Is Nothing Then[/COLOR]
                    FirstAddress = Rng.Address
             [COLOR=#0000ff]       Debug.Print [/COLOR]FirstAddress
                    OffFirstAddress = Range(FirstAddress).Offset(-1).Address
[COLOR=#0000ff]              End If[/COLOR]
The variable's value will now Print/Display in the Immediate Window. You would want to do this with the variables:First Address, Last Address and CountArrayItem (see if the count of the Company Name is correct). If you find that a value is not what you expect then look at your data to see what the inconsistency is...

This is also easily accomplished by using the Watch Window. Which essentially does the same thing....

Try out some of these methods and see if you can get the issue solved. If you can't solve them please post back. I would be happy to assist you further :)
 
Last edited:
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
No problem just let me know if you have questions. You may also want to note in the final procedure I gave you CountArrayItem is not actually used for anything (Notice I forgot to declare it at the start of the procedure). It was something that I inadvertently left in the code ahahah. I initially planned to take another approach by doing something like this:

Code: 
CountArrayItem = Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(2, Columns.Count)), CustArray(i))

[COLOR=#0000ff]Select Case [/COLOR]CountArrayItem
    
       [COLOR=#0000ff] Case[/COLOR] "1"
[COLOR=#008000]        'Code to cut data here etc....[/COLOR]
    [COLOR=#0000ff]    Case[/COLOR] "2"
       [COLOR=#0000ff] Case[/COLOR] "3"
     [COLOR=#0000ff]   Case[/COLOR] "4"
   [COLOR=#0000ff]     Case [/COLOR]"5"
     [COLOR=#0000ff]   Case[/COLOR] "6"
[COLOR=#0000ff]        End Select[/COLOR]
[COLOR=#0000ff]        [/COLOR]
[COLOR=#0000ff]    Next [/COLOR]i

In your case of debugging code it will probably come in handy though :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Copying from one worksheet to another with added complications
Replies
0
Views
552
rnewton
R
L
  • Question Question
How can I split datas in vertical into column
Replies
2
Views
244
LesterRonquillo
L
M
  • Question Question
VLookup formula and #N/A
Replies
8
Views
828
philwojo
P
WarPigl3t
  • Question Question
Printing causing Out of Memory
Replies
1
Views
285
WarPigl3t
WarPigl3t
H
  • Question Question
Creating a new table from data in another table (and auto entry upon modification)
Replies
1
Views
364
bschwartz
B

Forum statistics

Threads
1,226,224
Messages
6,189,726
Members
453,566
Latest member
ariestattle

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top