Code error

Rohith1324

Board Regular
Joined
Feb 27, 2018
Messages
71
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,668
Office Version
  1. 365
Platform
  1. Windows
Try it like this instead
VBA Code:
Sub Rohith()
   Dim oDict As Object
   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
   ReDim sData(1 To LastRow, 1 To 2)
   For i = 2 To LastRow
      If Not oDict.Exists(Cells(i, "A").Value) Then
         Cnt = Cnt + 1
         sData(Cnt, 1) = Cells(i, "A").Value
         sData(Cnt, 2) = Cells(i, "B").Value
         oDict.Add Cells(i, "A").Value, Cnt
      Else
         sData(oDict.Item(Cells(i, "A").Value), 2) = _
         sData(oDict.Item(Cells(i, "A").Value), 2) & _
         ", " & 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).Value = sData
   
End Sub
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Rohith1324

Board Regular
Joined
Feb 27, 2018
Messages
71
Try it like this instead
VBA Code:
Sub Rohith()
   Dim oDict As Object
   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
   ReDim sData(1 To LastRow, 1 To 2)
   For i = 2 To LastRow
      If Not oDict.Exists(Cells(i, "A").Value) Then
         Cnt = Cnt + 1
         sData(Cnt, 1) = Cells(i, "A").Value
         sData(Cnt, 2) = Cells(i, "B").Value
         oDict.Add Cells(i, "A").Value, Cnt
      Else
         sData(oDict.Item(Cells(i, "A").Value), 2) = _
         sData(oDict.Item(Cells(i, "A").Value), 2) & _
         ", " & 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).Value = sData
  
End Sub
Sure will try and keep you posted...but I have one more question....the previous script I was able to handle even the big data in my system but when I try it on with someone else system it is throwing error.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,668
Office Version
  1. 365
Platform
  1. Windows
That depends on what the error was.
It may have been a Compile Error, if they did not have the correct references set, or it may have been down to the data if it was a runtime error.
 

Rohith1324

Board Regular
Joined
Feb 27, 2018
Messages
71
T
Try it like this instead
VBA Code:
Sub Rohith()
   Dim oDict As Object
   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
   ReDim sData(1 To LastRow, 1 To 2)
   For i = 2 To LastRow
      If Not oDict.Exists(Cells(i, "A").Value) Then
         Cnt = Cnt + 1
         sData(Cnt, 1) = Cells(i, "A").Value
         sData(Cnt, 2) = Cells(i, "B").Value
         oDict.Add Cells(i, "A").Value, Cnt
      Else
         sData(oDict.Item(Cells(i, "A").Value), 2) = _
         sData(oDict.Item(Cells(i, "A").Value), 2) & _
         ", " & 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).Value = sData
  
End Sub
Thank you so much this is working fine now....
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,668
Office Version
  1. 365
Platform
  1. Windows
Glad it sorted & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,127,828
Messages
5,627,135
Members
416,223
Latest member
RichardHell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top