Snasui Excel Forum

Code: Select all

Sub searchtest()
Dim lastrow As Long, x As Long

lastrow = Sheets("data2").Cells(Rows.Count, 1).End(xlUp).Row


For x = 2 To lastrow
 If Sheets("data2").Cells(x, 1).Value = Sheets("Result").Range("a2").Value And Sheets("data2").Cells(x, 2).Value = Sheets("Result").Range("b2").Value Then
 Sheets("Result").Range("c2").Value = Sheets("data2").Cells(x, 3).Value
 Exit Sub
 End If
Next x




End Sub

Code: Select all

Sub A_Unique_B()
Dim X
Dim objDict As Object
Dim lngRow As Long

Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp)))

For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
Next
Range("F2:F" & objDict.Count) = Application.Transpose(objDict.Keys)
End Sub

Code: Select all

Sub FilterAndCopy()
Dim wstSource As Worksheet, _
    wstOutput As Worksheet
Dim rngMyData As Range, _
    helperRng As Range
Set wstSource = Worksheets("Data2")
Set wstOutput = Worksheets("Result")
Application.ScreenUpdating = False
With wstSource
    Set rngMyData = .Range("A2:C" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Set helperRng = rngMyData.Offset(, rngMyData.Columns.Count + 1).Resize(, 1)
With helperRng
    .FormulaR1C1 = "=if(countif(C1,RC1)>1,"""",1)"
    .Value = .Value
    .SpecialCells(xlCellTypeBlanks).EntireRow.Copy Destination:=wstOutput.Cells(1, 1)
    .ClearContents
End With
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub A_Unique_B()
Dim X
Dim objDict As Object
Dim lngRow As Long
Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp)))
For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
Next
Sheets("Sheet3").Range("C1:C" & objDict.Count).Offset(7, 0) = Application.Transpose(objDict.Keys)
End Sub

Code: Select all

Sub summaryReport()
Dim X
Dim objDict As Object
Dim lngRow As Long

Set objDict = CreateObject("Scripting.Dictionary")
Sheet1.Select
X = Application.Transpose(Range([a2], Cells(Rows.Count, "A").End(xlUp)))

For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
     
Next
  
  

Sheet3.Select
Range("C7:C" & objDict.Count) = Application.Transpose(objDict.Keys)
End Sub

Code: Select all

Application.Transpose(Range([a2], Cells(Rows.Count, "A").End(xlUp)))

Code: Select all

Sub summaryReport()
Dim X
Dim objDict As Object
Dim lngRow As Long
Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range([a2], Cells(Rows.Count, "A").End(xlUp)))
For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
Next
Sheet3.Range("C1:C" & objDict.Count).Offset(6, 0) = Application.Transpose(objDict.Keys)
End Sub