Unique Values and Double Values in Excel VBA

kate.middleton

New Member
Joined
Mar 24, 2012
Messages
31
Hello Everybody,

I have an Input Values something like this,
InputOutput
11
11
2Empty Row
32
3Empty Row
33
43
3
Empty Row
4
I want output like this using VBA.

<colgroup><col style="width:60pt" width="80"> <col style="width:60pt" span="2" width="80"> <col style="width:60pt" width="80"> </colgroup><tbody>
</tbody>

<tbody>
</tbody>
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Select your values and run this:

Code:
Sub AddBlankRow()
Dim rng As Range
Dim rCell As Range
Dim i As Long
Dim NewCount As Long


Set rng = Selection
i = rng.Row
If rng.Columns.Count > 1 Then MsgBox "Too many columns have been selected, this will terminate.": Exit Sub


For Each rCell In rng
    If LCase(rCell.Offset(-1, 0).Value) = "input" Or rCell.Offset(-1, 0).Value = rCell.Value Then
        Cells(i, rng.Column + 2).Value = rCell.Value
        i = i + 1
    Else
        Cells(i, rng.Column + 2).Value = ""
        Cells(i + 1, rng.Column + 2).Value = rCell.Value
        i = i + 2
    End If
Next rCell


End Sub
 
Upvote 0
Hello,
Thanks for your reply. This macro is not producing the same Output as desired.
Actually i want that if the Cells value in Input Column Changes then it make the Empty cell in Output Column.
 
Upvote 0
Hello,
Thanks for your reply. This macro is not producing the same Output as desired.
Actually i want that if the Cells value in Input Column Changes then it make the Empty cell in Output Column.

I don't understand what you are asking.

Please provide an example of the before and after.
 
Upvote 0
Input Data
1
1
2
2
3
3
3
3
4
5
6
When i run the Macro the Output should come like this,

<tbody>
</tbody>
Output Data
1
1
Empty cell
2
2
Empty cell
3
3
3
3
Empty cell
4
Empty cell
5
Empty cell
6

<tbody>
</tbody>
 
Upvote 0
The macro I posted does this.

Select you Input Data, don't include the header and run the macro.

The output will appear two columns to the right with a space between each changing value.
 
Upvote 0
Just another option !!!
Code:
[COLOR="Navy"]Sub[/COLOR] MG22Sep36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Rng.Offset(, 2).Value = Rng.Value
[COLOR="Navy"]For[/COLOR] n = Lst To 3 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]With[/COLOR] Range("C" & n)
        [COLOR="Navy"]If[/COLOR] Not .Offset(-1).Value = .Value [COLOR="Navy"]Then[/COLOR] .Insert shift:=xlDown
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG22Sep27
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray
[COLOR="Navy"]Dim[/COLOR] Lst     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Nn      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Ray = Application.Transpose(Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)))
ReDim Preserve Ray(1 To UBound(Ray) * 2)
[COLOR="Navy"]For[/COLOR] n = UBound(Ray) To 2 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]If[/COLOR] Not Ray(n) = Ray(n - 1) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] Nn = n To UBound(Ray) - 1
            Temp = Ray(Nn + 1)
            Ray(Nn + 1) = Ray(n)
            Ray(n) = Temp
        [COLOR="Navy"]Next[/COLOR] Nn
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
Range("C2").Resize(UBound(Ray)).Value = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
kate.middleton,

The following macro uses two arrays in memory.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Sub ReorgData()
' hiker95, 09/22/2014, ME806965
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = Range("A1:A" & lr)
ReDim o(1 To lr * 2, 1 To 1)
For i = 2 To lr Step 1
  If a(i, 1) = a(i - 1, 1) Then
    j = j + 1
    o(j, 1) = a(i, 1)
  ElseIf a(i, 1) <> a(i - 1, 1) Then
    j = j + 1
    o(j, 1) = a(i - 1, 1)
    j = j + 1
  End If
Next i
j = j + 1
o(j, 1) = a(lr, 1)
Cells(1, 3).Resize(lr * 2, 1).Value = o
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.
 
Upvote 0

Forum statistics

Threads
1,213,517
Messages
6,114,085
Members
448,548
Latest member
harryls

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