VBA - If C2 = x, Move D2 to Next Available

T

The Great SrH

Board Regular
Joined
Jan 16, 2015
Messages
179
Hi all,

I'm really sorry as I'm struggling to even describe what I'm asking help for here.

I basically have a list of 30,000 rows of data where Column C is the unique number relating to a customer and Column D is a product they hold.

I'm looking for some code to do something like run down the list and if Column C exists, move the information into the next available column after Column D.


For the sake of an example, I'm using Column A as the Unique Number and Column B is the product.


Current List:


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Row
[/TD]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Unique Number
[/TD]
[TD]Product
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]12345
[/TD]
[TD]Banana
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]12345
[/TD]
[TD]Pear
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]7210
[/TD]
[TD]Apple
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]12345
[/TD]
[TD]Apple
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]1234
[/TD]
[TD]Grape
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]7210
[/TD]
[TD]Berry
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]7210
[/TD]
[TD]Melon
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]12345
[/TD]
[TD]Grape
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]12345
[/TD]
[TD]Melon
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]7210
[/TD]
[TD]Banana
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]5065
[/TD]
[TD]Banana
[/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]5792
[/TD]
[TD]Apple
[/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD]5792
[/TD]
[TD]Pear
[/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD]8090
[/TD]
[TD]Grape
[/TD]
[/TR]
</tbody>[/TABLE]


Desired Output:

[TABLE="class: grid, width: 750, align: center"]
<tbody>[TR]
[TD]Row
[/TD]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[TD]Column E
[/TD]
[TD]Column F
[/TD]
[TD]Column G
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Unique Number
[/TD]
[TD]Product
[/TD]
[TD]Product
[/TD]
[TD]Product
[/TD]
[TD]Product
[/TD]
[TD]Product
[/TD]
[TD]Product
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]12345
[/TD]
[TD]Banana
[/TD]
[TD]Pear
[/TD]
[TD]Apple
[/TD]
[TD]Grape
[/TD]
[TD]Melon
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]7210
[/TD]
[TD]Apple
[/TD]
[TD]Berry
[/TD]
[TD]Melon
[/TD]
[TD]Banana
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]1234
[/TD]
[TD]Grape
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]5065
[/TD]
[TD]Banana
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]5792
[/TD]
[TD]Apple
[/TD]
[TD]Pear
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]8090
[/TD]
[TD]Grape
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
How about
Code: 
Sub TheGreatSrH()
   Dim Ary As Variant
   Dim r As Long
   
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      Ary = .Range("C2", .Range("C" & Rows.Count).End(xlUp).Offset(, 1)).Value2
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 1)) Then
            .add Ary(r, 1), Ary(r, 2)
         Else
            .Item(Ary(r, 1)) = .Item(Ary(r, 1)) & "|" & Ary(r, 2)
         End If
      Next r
      Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A2").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
   End With
   With Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
      .Range("B2:B" & Rows.Count).TextToColumns .Range("B2"), xlDelimited, xlTextQualifierNone, False, False, False, False, False, True, "|"
   End With
End Sub
Change values in red to suit
 
Upvote 0
Fluff said:
How about
Code: 
Sub TheGreatSrH()
   Dim Ary As Variant
   Dim r As Long
   
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      Ary = .Range("C2", .Range("C" & Rows.Count).End(xlUp).Offset(, 1)).Value2
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 1)) Then
            .add Ary(r, 1), Ary(r, 2)
         Else
            .Item(Ary(r, 1)) = .Item(Ary(r, 1)) & "|" & Ary(r, 2)
         End If
      Next r
      Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A2").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
   End With
   With Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
      .Range("B2:B" & Rows.Count).TextToColumns .Range("B2"), xlDelimited, xlTextQualifierNone, False, False, False, False, False, True, "|"
   End With
End Sub
Change values in red to suit
Click to expand...

That looks perfect! Thank you so much.

Would it be possible to move the contents of A & B to go next to C in the new Sheet?

Also, to complicate it more - Every product has another cell next to it with a number. So using the desired output above, Column B would still be the Product and then there would be another number next to it (originally in Column E).
 
Upvote 0
For future reference it's best to show exactly what you want rather than an oversimplification.
Can you post 3 or rows of data showing what you have & what you want.
 
Upvote 0
Really sorry about that - I only realised after putting your code to test that I actually needed the other data!

The Great SrH said:
Current List:


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Row
[/TD]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C

[/TD]
[TD]Column D

[/TD]
[TD]Column E
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Ref
[/TD]
[TD]Other
[/TD]
[TD]Unique Number

[/TD]
[TD]Product
[/TD]
[TD]Extra
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]1
[/TD]
[TD]A
[/TD]
[TD]12345
[/TD]
[TD]Banana
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]2
[/TD]
[TD]B
[/TD]
[TD]12345
[/TD]
[TD]Pear
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]3
[/TD]
[TD]C
[/TD]
[TD]7210
[/TD]
[TD]Apple
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]4
[/TD]
[TD]D
[/TD]
[TD]12345
[/TD]
[TD]Apple
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]5
[/TD]
[TD]E
[/TD]
[TD]1234
[/TD]
[TD]Grape
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]6
[/TD]
[TD]F
[/TD]
[TD]7210
[/TD]
[TD]Berry
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]7
[/TD]
[TD]G
[/TD]
[TD]7210
[/TD]
[TD]Melon
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]8
[/TD]
[TD]H
[/TD]
[TD]12345
[/TD]
[TD]Grape
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]9
[/TD]
[TD]I
[/TD]
[TD]12345
[/TD]
[TD]Melon
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]10
[/TD]
[TD]J
[/TD]
[TD]7210
[/TD]
[TD]Banana
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]11
[/TD]
[TD]Q
[/TD]
[TD]5065
[/TD]
[TD]Banana
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]12
[/TD]
[TD]L
[/TD]
[TD]5792
[/TD]
[TD]Apple
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]14

[/TD]
[TD]13
[/TD]
[TD]M
[/TD]
[TD]5792
[/TD]
[TD]Pear
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]15

[/TD]
[TD]14
[/TD]
[TD]N
[/TD]
[TD]8090
[/TD]
[TD]Grape
[/TD]
[TD]2
[/TD]
[/TR]
</tbody>[/TABLE]


Desired Output:

[TABLE="class: grid, width: 750, align: center"]
<tbody>[TR]
[TD]Row
[/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C

[/TD]
[TD]D

[/TD]
[TD]E
[/TD]
[TD]F

[/TD]
[TD]G
[/TD]
[TD]H

[/TD]
[TD]I
[/TD]
[TD]J

[/TD]
[TD]K
[/TD]
[TD]L

[/TD]
[TD]M

[/TD]
[/TR]
[TR]
[TD]1

[/TD]
[TD]Ref
[/TD]
[TD]Other
[/TD]
[TD]Unique Number

[/TD]
[TD]Product
[/TD]
[TD]Extra
[/TD]
[TD]Product
[/TD]
[TD]Extra
[/TD]
[TD]Product
[/TD]
[TD]Extra
[/TD]
[TD]Product
[/TD]
[TD]Extra
[/TD]
[TD]Product
[/TD]
[TD]Extra

[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]1
[/TD]
[TD]A
[/TD]
[TD]12345
[/TD]
[TD]Banana
[/TD]
[TD]2
[/TD]
[TD]Pear
[/TD]
[TD]1
[/TD]
[TD]Apple
[/TD]
[TD]2
[/TD]
[TD]Grape
[/TD]
[TD]2
[/TD]
[TD]Melon
[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]C
[/TD]
[TD]7210
[/TD]
[TD]Apple
[/TD]
[TD]1
[/TD]
[TD]Berry
[/TD]
[TD]1
[/TD]
[TD]Melon
[/TD]
[TD]2
[/TD]
[TD]Banana
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]5
[/TD]
[TD]E
[/TD]
[TD]1234
[/TD]
[TD]Grape
[/TD]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]11
[/TD]
[TD]Q
[/TD]
[TD]5065
[/TD]
[TD]Banana
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]12
[/TD]
[TD]L
[/TD]
[TD]5792
[/TD]
[TD]Apple
[/TD]
[TD]1
[/TD]
[TD]Pear
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]14
[/TD]
[TD]N
[/TD]
[TD]8090
[/TD]
[TD]Grape
[/TD]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
 
Upvote 0
Try
Code: 
Sub TheGreatSrH()
   Dim Ary As Variant, Tmp As Variant, Ky As Variant
   Dim r As Long
   
   With Sheets("Roster")
      Ary = .Range("A2", .Range("C" & Rows.Count).End(xlUp).Offset(, 2)).Value2
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 3)) Then
            .add Ary(r, 3), Array(Ary(r, 1), Ary(r, 2), Ary(r, 3), Ary(r, 4), Ary(r, 5))
         Else
            Tmp = .Item(Ary(r, 3))
            ReDim Preserve Tmp(0 To UBound(Tmp) + 2)
            Tmp(UBound(Tmp) - 1) = Ary(r, 4)
            Tmp(UBound(Tmp)) = Ary(r, 5)
            .Item(Ary(r, 3)) = Tmp
         End If
      Next r
      For Each Ky In .Keys
         Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, UBound(.Item(Ky)) + 1).Value = .Item(Ky)
      Next Ky
   End With
End Sub
 
Upvote 0
Fluff said:
Try
Code: 
Sub TheGreatSrH()
   Dim Ary As Variant, Tmp As Variant, Ky As Variant
   Dim r As Long
   
   With Sheets("Roster")
      Ary = .Range("A2", .Range("C" & Rows.Count).End(xlUp).Offset(, 2)).Value2
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 3)) Then
            .add Ary(r, 3), Array(Ary(r, 1), Ary(r, 2), Ary(r, 3), Ary(r, 4), Ary(r, 5))
         Else
            Tmp = .Item(Ary(r, 3))
            ReDim Preserve Tmp(0 To UBound(Tmp) + 2)
            Tmp(UBound(Tmp) - 1) = Ary(r, 4)
            Tmp(UBound(Tmp)) = Ary(r, 5)
            .Item(Ary(r, 3)) = Tmp
         End If
      Next r
      For Each Ky In .Keys
         Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, UBound(.Item(Ky)) + 1).Value = .Item(Ky)
      Next Ky
   End With
End Sub
Click to expand...

Thanks so much for this - Is it possible for you to explain what you did to change this? I'm waiting for a different report to come in which may need another column moving across - but it's good for me to learn too!
 
Upvote 0
If you would like to comment the code with your understanding of what is happening, I will happily fill in the blanks & correct any misunderstandings if needed.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
572
B-radK
B
S
  • Question Question
VBA Code- finding #Spill and moving the formula to the next column
Replies
0
Views
831
stromnoexcel
S
K
  • Solved
Flagging Unique and Duplicate values via VBA
Replies
2
Views
712
Kiwihiker
K
J
  • Solved
Google sheets uniqueif without a helper column
Replies
1
Views
122
Jaque_Thay
J
T
  • Solved
Lookup across multiple dynamic array columns
Replies
2
Views
2K
Tashat
T

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top