acerlaptop
02-17-2020, 02:45 AM
Hi everyone,
I have a data that looks like this.
Column A Column B Column C
A 1
A 1
B 0
C 1
C 0
D 1
What the code does is that it paste values of Column A to Column C that passes a criteria w/c is "1".
What I want to do is remake the code so that Column C will be in a different worksheet (Sheet2) column A:A. Also the criteria will be from Sheet2 Cell A1. Also, column A:A is limited to 5 rows because row 6 onwards has values in it so if there are more, the code will insert another row, then will delete the extra rows if the values does not exceed row 5. (5 rows is the default)
Option Explicit
Sub Test()
Dim x As Variant
Dim objDict As Object
Dim lngRow As Long
Set objDict = CreateObject("Scripting.Dictionary")
With Sheet1
x = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(XlDirection.xlUp)).Value
For lngRow = 1 To UBound(x, 1)
If x(lngRow, 2) = 1 Then
objDict(x(lngRow, 1)) = 1
End If
Next
.Range(.Cells(1, 3), .Cells(objDict.Count, 3)).Value = Application.Transpose(objDict.Keys)
End With
Set objDict = Nothing
End Sub
I have a data that looks like this.
Column A Column B Column C
A 1
A 1
B 0
C 1
C 0
D 1
What the code does is that it paste values of Column A to Column C that passes a criteria w/c is "1".
What I want to do is remake the code so that Column C will be in a different worksheet (Sheet2) column A:A. Also the criteria will be from Sheet2 Cell A1. Also, column A:A is limited to 5 rows because row 6 onwards has values in it so if there are more, the code will insert another row, then will delete the extra rows if the values does not exceed row 5. (5 rows is the default)
Option Explicit
Sub Test()
Dim x As Variant
Dim objDict As Object
Dim lngRow As Long
Set objDict = CreateObject("Scripting.Dictionary")
With Sheet1
x = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(XlDirection.xlUp)).Value
For lngRow = 1 To UBound(x, 1)
If x(lngRow, 2) = 1 Then
objDict(x(lngRow, 1)) = 1
End If
Next
.Range(.Cells(1, 3), .Cells(objDict.Count, 3)).Value = Application.Transpose(objDict.Keys)
End With
Set objDict = Nothing
End Sub