Rohith1324
Board Regular
- Joined
- Feb 27, 2018
- Messages
- 114
Hi
I have excel sheet with 2 Columns
column 1 will have repetative values - 1 Value might repeat almost 50 - 100 Time and in the second Column the it will have the numbers
below is code i'm using and in some system the code is getting executed and in some the code is not getting executed, can someone please help :
Dim oDict As Dictionary
Dim sData() As Variant
Dim LastRow As Long
Dim i As Variant
Dim Cnt As Variant
Set oDict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Not oDict.Exists(Cells(i, "A").Value) Then
Cnt = Cnt + 1
ReDim Preserve sData(1 To 2, 1 To Cnt)
sData(1, Cnt) = Cells(i, "A").Value
sData(2, Cnt) = Cells(i, "B").Value
oDict.Add Cells(i, "A").Value, Cnt
Else
sData(2, oDict.Item(Cells(i, "A").Value)) = _
sData(2, oDict.Item(Cells(i, "A").Value)) & _
", " & Cells(i, "B").Value
End If
Next i
Range("G1").Value = Range("A1").Value
Range("H1").Value = Range("B1").Value
Range("I1").Value = "Circle"
Range("J1").Value = "HW/SW"
'Transfer the contents of the array to a worksheet range, starting at D2
Range("G2").Resize(UBound(sData, 2), 2).Value = _
WorksheetFunction.Transpose(sData)
End Sub
I have excel sheet with 2 Columns
column 1 will have repetative values - 1 Value might repeat almost 50 - 100 Time and in the second Column the it will have the numbers
below is code i'm using and in some system the code is getting executed and in some the code is not getting executed, can someone please help :
Dim oDict As Dictionary
Dim sData() As Variant
Dim LastRow As Long
Dim i As Variant
Dim Cnt As Variant
Set oDict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Not oDict.Exists(Cells(i, "A").Value) Then
Cnt = Cnt + 1
ReDim Preserve sData(1 To 2, 1 To Cnt)
sData(1, Cnt) = Cells(i, "A").Value
sData(2, Cnt) = Cells(i, "B").Value
oDict.Add Cells(i, "A").Value, Cnt
Else
sData(2, oDict.Item(Cells(i, "A").Value)) = _
sData(2, oDict.Item(Cells(i, "A").Value)) & _
", " & Cells(i, "B").Value
End If
Next i
Range("G1").Value = Range("A1").Value
Range("H1").Value = Range("B1").Value
Range("I1").Value = "Circle"
Range("J1").Value = "HW/SW"
'Transfer the contents of the array to a worksheet range, starting at D2
Range("G2").Resize(UBound(sData, 2), 2).Value = _
WorksheetFunction.Transpose(sData)
End Sub