Search to blank and merge macro help needed

[rickyckc]

Hi everyone,

I need your excel macro expertise help. Suppose I have a column of data like this:

A1: Router A
A2: Router B
A3: Router B
A4: Router B
A5: Switch A
A6: Switch B
A7: Switch C
A8: Switch C
A9: Switch C

Now, I need a macro that will first of all, search and blank off A3, A4, A8 and A9 since they are repeating and stops when no more repeats are found. And later part is to merge A2-A4 and A7-A9. Important is the 'search & blank' and 'merge' part is not cell specified. Hope you understand what I am trying to accomplish. Thanks for your attention and time.



Best Regards,
Ricky

 

[Juan Pablo González]

You only clear it if the cell above is the same ? for example, you won't clear A5 or A6 even they appear above on the list ?

 

[tactps]

Assuming your list is sorted, try this (not neat but will work):

Sub macro()
Range("A100").Select
Selection.End(xlUp).Select
counter = 0
Test1 = ActiveCell.Text
Test2 = ActiveCell.Offset(-1, 0).Text
Test3 = ActiveCell.Row
Do Until counter = Test3
If Test1 = Test2 Then
Selection.ClearContents
End If
ActiveCell.Offset(-1, 0).Select
counter = counter + 1
Test1 = ActiveCell.Text
On Error GoTo Finish
Test2 = ActiveCell.Offset(-1, 0).Text
Loop

Finish:
MsgBox ("Done")
End Sub

 

[rickyckc]

Hi Juan Pablo González,

Yes, correct

Hi tactps,

Thanks, will try it out

 

[rickyckc]

Hi tactps,

I have tried yur scripts, works great but I still have 3 questions :P

1) Your script will not work if the column A is not sorted, corect ?
(sorry, I have not tried that out yet)

2) I need to set the range ? Can it somehow be 'auto' (meaning no need to set range)

3) How about the merge part ? Based on my column example, I need to merge A2, A3 and A4 together as one cell.

Thanks again.

Best Regards,
Ricky

 

[rickyckc]

BTW, how am i able ti attach a sample file ? Any idea ?

Best Regards,
Ricky

 

[tactps]

Your post:
1) Your script will not work if the column A is not sorted, corect ?
(sorry, I have not tried that out yet)

2) I need to set the range ? Can it somehow be 'auto' (meaning no need to set range)

3) How about the merge part ? Based on my column example, I need to merge A2, A3 and A4 together as one cell.

Re:
1) - correct. you would need to sort the code in column A
2) - I have it going to the bottom of column A (assuming that you have less than 100 rows).
If not, change:
Range("A100").Select
to
Range("A60000").select

3) I am not sure what you mean by merge. Do you have data in other columns?

Perhaps you need to post your spreadsheet (details changed to protect the guilty) using Colo's HTML Maker (bottom of screen).

Then I'm sure we can help you out better.

 

[rickyckc]

Hi tactps,

I have created a html sample .....DUH.....now how do I post/show it ?



Best Regards,
Ricky

 

[rickyckc]

Hi tactps,

sample.xls
	A	B	C	D
1	Hostname	IPAddress	DeviceType	Location
2	AIX_Server_A	4.3.2.1	AXI	HongKong
3	Switch_A	5.6.7.8	SWITCH	Singapore
4	Switch_A	5.6.8.7	SWITCH	Singapore
5	Switch_A	5.6.8.9	SWITCH	Singapore
6	Netware_Server_A	1.1.1.1	NETWARE	Japan
7	Router_A	6.7.3.4	ROUTER	USA
8	Router_A	6.7.8.9	ROUTER	USA
9	Router_A	6.7.9.8	ROUTER	USA
10	SUN_Server_A	2.2.2.2	SUN	Korea
11	Linux_Server_A	3.3.3.3	LINUX	Australia
12	Router_B	9.8.7.6	ROUTER	Thailand
13	Router_B	9.8.1.2	ROUTER	Thailand
14	Router_B	9.8.3.4	ROUTER	Thailand
15
16	Hostname	IPAddress	DeviceType	Location
17	AIX_Server_A	4.3.2.1	AXI	HongKong
18	Switch_A	5.6.7.8	SWITCH	Singapore
19		5.6.8.7
20		5.6.8.9
21	Netware_Server_A	1.1.1.1	NETWARE	Japan
22	Router_A	6.7.3.4	ROUTER	USA
23		6.7.8.9
24		6.7.9.8
25	SUN_Server_A	2.2.2.2	SUN	Korea
26	Linux_Server_A	3.3.3.3	LINUX	Australia
27	Router_B	9.8.7.6	ROUTER	Thailand
28		9.8.1.2
29		9.8.3.4
All Devices

OK. I have managed to figure it out how to post the html file.

Now.....the top portion is the raw file

and the bottom portion is my preferred final output

Thanks.

Best Regards,
Ricky

 

[tactps]

This should be close to what you want. I'm sure an MVP out there can clean it up a fair bit as it is far longer than it needs to be:

Sub macro()
Range("A100").Select
Selection.End(xlUp).Select
counter = 0
Test1 = ActiveCell.Text
Test2 = ActiveCell.Offset(-1, 0).Text
Test3 = ActiveCell.Row
Do Until counter = Test3
If Test1 = Test2 Then
Selection.ClearContents
End If
ActiveCell.Offset(-1, 0).Select
counter = counter + 1
Test1 = ActiveCell.Text
On Error GoTo Step2
Test2 = ActiveCell.Offset(-1, 0).Text
Loop


Step2:
Range("A1").Select
countermerge = 0
Do While countermerge < 100
On Error GoTo Finish
Merge1 = ActiveCell.Text
Merge2 = ActiveCell.Offset(1, 0).Text
Merge3 = ActiveCell.Offset(2, 0).Text
Merge4 = ActiveCell.Address
Merge5 = ActiveCell.Offset(2, 0).Address

If Merge1 <> "" And Merge2 = "" And Merge3 = "" Then
Range(Merge4 & ":" & Merge5).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
If Selection.Interior.ColorIndex = ActiveCell.Offset(-1, 0).Interior.ColorIndex Then
If Selection.Interior.ColorIndex = xlNone Then
Selection.EntireRow.Select
Selection.Interior.ColorIndex = 6
Else
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = xlNone
End If
End If
End If

countermerge = countermerge + 1
ActiveCell.Offset(1, 0).Select
Loop

Finish:
MsgBox ("Done")
End Sub