Inserting Names from range

bearcub · Aug 19th 2004

I have a spreadsheet with transactions by customers. I want make a list of them in another section of the spreadsheet without duplicating their names.
I have the following code:

Code

On Error Resume Next
Dim Startrow, Endrow, i, j
Application.ScreenUpdating = False
Startrow = Val(Application.InputBox("First Row number"))
Endrow = Val(Application.InputBox("Last Row number"))
If Startrow > Endrow Then
  MsgBox "Start Row is past the End Row, try again"
  Exit Sub
End If
 j = ActiveCell
For i = Endrow To Startrow Step -1
    If Cells(i, 10).Value <> Cells(i, 10).Offset(-1, 0) Then
      ActiveCell.Value = Cells(1, 10)
    End If
    j = j + 1
  Next
Application.ScreenUpdating = True

Display More

The problem I have having is moving the destination line down one line. How do I do that with this. I am using the j variable to represent the destination cell.

Thanks

jindon · Aug 20th 2004

Hi

try the code

Code

Dim i As Integer, r As Range, j As Range, x, y
On Error Resume Next
Set r = Application.InputBox("Select Range", Type:=8)
Set j = ActiveCell
    Application.ScreenUpdating = False
    With r
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        .SpecialCells(xlCellTypeVisible).Copy Destination:=j
    End With
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    i = j.Row + 1
    Do While Cells(i, j.Column).Value <> ""
        If Cells(i, j.Column).Value = j.Value Then
            Cells(i, j.Column).Delete shift:=xlUp
            i = i
        End If
        i = i + 1
    Loop
    Application.ScreenUpdating = True

Display More

hope it helps

jindon

bearcub · Aug 20th 2004

sorry, I gave wrong information

JLindon,

Sorry, I didn't want to delete the rows. This is what I want to do

in 1 range I have names:

source: Destination
Joe Joe
Joe Mick
Mick Mike
Mick Johnny
Mike John
Johnny
Johnny
John

what I did with the code i sent was to modify it slightly. I wanted to replace the delete rows with the list in the destination column. What I couldn't figure out was how to make the code go from Joe to Mick, Mick to Mike, Mike to Johnny and Johnny to John.

Can the code that I originally sent be modified to do this or would something else be needed.

Thanks for your help.

jindon · Aug 20th 2004

Hi,

then try

Code

Dim lastI As Long
Application.ScreenUpdating = False
With ActiveSheet
    .Columns("j:j").ClearContents
    lastI = .Range("i65536").End(xlUp).Row
    With .Range("i1:i" & lastI)
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        .SpecialCells(xlCellTypeVisible).Copy _
            Destination:=Range("j1")
    End With
End With
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Application.ScreenUpdating = True

Display More

hope it helps

jindon

bearcub · Aug 20th 2004

Thanks JLindon, works like a charm

Could you explain the elements within the With section? If some of these lines are excluded, will it run properly?

jindon · Aug 21st 2004

Hi,

I thnik you can change, but cannot exclude any of line within With section.
Following is the brief explanation.

Code

Dim lastI As Long 
Application.ScreenUpdating = False 
With ActiveSheet 
    .Columns("j:j").ClearContents 
    lastI = .Range("i65536").End(xlUp).Row 
    With .Range("i1:i" & lastI) 
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True '<-- utilse advanced filter 
        .SpecialCells(xlCellTypeVisible).Copy _                      'to get only unique value within the range
        Destination:=Range("j1") <---  'copy the extracted value and paste to cell J1
    End With 
End With 
Application.CutCopyMode = False '<-- you don't need this, actually
ActiveSheet.ShowAllData  '<-- reset advanced filter
Application.ScreenUpdating = True

Display More

compare with for-next

Code

Dim i As Long, lastI As Long, lastJ As Long
Application.ScreenUpdating = False
With ActiveSheet
    .Columns("j:j").ClearContents
    lastI = .Range("i65536").End(xlUp).Row
    .Columns("i:i").Sort key1:=.Range("i1")
    .Cells(1, "j").Value = .Cells(1, "i").Value
    For i = 1 To lastI
        lastJ = .Range("j65536").End(xlUp).Row
        If .Cells(i, "i").Value <> .Cells(lastJ, "j").Value Then
            Cells(lastJ + 1, "j").Value = .Cells(i, "i").Value
        End If
    Next
End With
Application.ScreenUpdating = True

Display More

hope it helps
jindon

Inserting Names from range

Participate now!

Share

Users Viewing This Thread