Returning values listed under multiple conditions

[Tee51]

Hello,

I have two problems:

1) Can someone help me modify the code below so that it pulls data fro
columns other than column A on sheet1?

2) Can someone help me modify the code below so that the heading i
column A sheet3 does not clear?

I’m working on a code that will filter through columns H & I in o
sheet1 and list the values from column H that are listed multiple time
under different conditions. Sheet1 was used to test the code on text i
the same sheet. Sheet3 is used to test the code on an active an
inactive sheet. Simply, I was trying to get the return values to appea
on a different sheet and it works. But another issue occurred, I canno
figure out how to clear the content in column A of sheet3 withou
clearing the heading.


Code
-------------------

Sub CommandButton1_Click()

Dim Data As Variant
Dim Dict As Object
Dim Key As String
Dim MyList() As Variant
Dim n As Long
Dim Rng As Range
Dim Wks As Worksheet

Set Wks = ActiveSheet

Set Rng = Worksheets("Sheet1").Range("A1").CurrentRegion
Wks.Columns(1).ClearContents

Data = Rng.Resize(ColumnSize:=2).Value

Set Dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(Data, 1)
Key = Trim(Data(i, 1))
If Key <> "" Then
If Not Dict.Exists(Key) Then
Dict.Add Key, Data(i, 2)
End If
If Dict(Key) <> Data(i, 2) Then
ReDim Preserve MyList(n)
MyList(n) = Key
n = n + 1
End If
End If
Next i

If Dict.Count > 0 Then
Wks.Range("A2").Resize(UBound(MyList, 1) + 1).Value = Application.Transpose(MyList)
End If

End Sub

-------------------

+-------------------------------------------------------------------
|Filename: List Multiple Events.zip
|Download: http://www.excelbanter.com/attachment.php?attachmentid=481
+-------------------------------------------------------------------

 

[isabelle]

hi,

With Wks
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).ClearContents
End With


or

With Wks
.Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
End With

--
isabelle



Le 2012-07-20 13:15, Tee51 a écrit :

 

[Tee51]

hi,

With Wks
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row
1)).ClearContents
End With


or

With Wks
.Range("A2:A" & .Range("A"
.Rows.Count).End(xlUp).Row).ClearContents
End With

--
isabelle



Le 2012-07-20 13:15, Tee51 a écrit :-

Hi,

Thanks for the response. The first code works perfectly. Do you know ho
to change the code so that it uses date from column H instead of colum
A

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[isabelle]

yes, you must replace 1 by 8

With Wks
.Range(.Cells(2, 8), .Cells(.Cells(.Rows.Count, 8).End(xlUp).Row, 8)).ClearContents
End With

 

[Tee51]

Sorry for the delay

That suggestion did not help maybe I am missing something

Code
-------------------

Sub CommandButton1_Click(

Dim Data As Varian
Dim Dict As Objec
Dim Key As Strin
Dim MyList() As Varian
Dim n As Lon
Dim Rng As Rang
Dim Wks As Workshee

Set Wks = ActiveShee

Set Rng = Worksheets("Sheet1").Range("A1").CurrentRegio
With Wk
.Range(.Cells(2, 8), .Cells(.Cells(.Rows.Count, 8).End(xlUp).Row, 8)).ClearContent
End Wit



Data = Rng.Resize(ColumnSize:=2).Valu

Set Dict = CreateObject("Scripting.Dictionary"

For i = 1 To UBound(Data, 1
Key = Trim(Data(i, 1)
If Key <> "" The
If Not Dict.Exists(Key) The
Dict.Add Key, Data(i, 2
End I
If Dict(Key) <> Data(i, 2) The
ReDim Preserve MyList(n
MyList(n) = Ke
n = n +
End I
End I
Next

If Dict.Count > 0 The
Wks.Range("A2").Resize(UBound(MyList, 1) + 1).Value = Application.Transpose(MyList
End I

End Su

 

[isabelle]

hi,

With Worksheets("Sheet1")
.Range(.Cells(1, 8), .Cells(.Cells(.Rows.Count, 8).End(xlUp).Row, 8)).ClearContents
End With


--
isabelle



Le 2012-08-21 15:19, Tee51 a écrit :

 

[Tee51]

That code cleared out Column H and is still returning Column A values

+-------------------------------------------------------------------
+-------------------------------------------------------------------