Hi,

Essentially I would like to have a list of product ID, or descriptions converted to a short hand version.

For example I want to convert all product IDs that are pouches converted to Pouch. Such as:

PCHD01D, PCHDO1J, PCHD02D to be displayed simply as Pouch and I would like to do this for 16,000 varying items.  I was thinking of using a VBA array to accomplish this, but in my mind, I believe that there is probably a better way to handle this.  I appreciate your suggestions.

Thanks

You could use formulas - Make up a table of your 'conversions' based on the leading characters, like this, if it is based on the first 3 characters

PCH     Pouch

CTN     Carton

PLT      Pallet

etc. etc.

And then use a formula like

=VLOOKUP(LEFT(A2,3),$G$2:$H$10,2,False)

where PCHD01D is in cell A2 and the table you created is in G:H starting in row 2.

VBA would work better if you have different length codes to check: you would just step through the possibilities:

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,4)= "CRTN" Then C.Value = "Carton"

Next C

End Sub

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 12 hours 44 minutes ago

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor 12 hours 30 minutes ago

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 Tuesday, May 12, 2015 6:46 PM

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 Tuesday, May 12, 2015 6:46 PM

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 Tuesday, May 12, 2015 6:46 PM

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 Tuesday, May 12, 2015 6:46 PM

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 Tuesday, May 12, 2015 6:46 PM

Thanks!  The codes are different lengths and I should have posted a sample of the data im using (the column titles are what I want returned).

Pouch	Maverick	Vision	Helmet	Plate	Shield
PCH010D	MK1020JB	BT7N00BV0M	HLMH760	10022-10X12	DLS3A20X34L
PCH011AC0D	MK1020JF	BT7N00MB	HLMH760-RM	10022-5X7	DLS3A20X34L-RM
PCH011AC0J	MK102TJB	BT7N00MF	HLMH760000	10022-5X8	DLS3A20X36
PCH011D	MK102TJF	BT7N00NT0M	HLMH770	10022-6X8	DLS3A20X36-RM
PCH011J	MK1030JB	BT7NT0MB	HLMH770-RM	10022-7X10	DLS3A20X36L
PCH012AC0C	MK1030JF	BT7NT0MF	HLMH770000	10022-7X9	DLS3A20X36L-RM
PCH012AC0D	MK103TJB	BT7PP2BV0M	HLMH780	10022-8X10	DLS3A2436
PCH012AC0J	MK103TJF	BT7PP2CS0M	HLMH780-RM	10022-LG-RM	DLS3A2436L
PCH012C	MK1040JB	BT7PP2KT0M	HLMH780000	10022-MD-RM	DLS3A24X36
PCH012D	MK1040JF	BT7PP2NT0M	HLMH790	10022-SM-RM	DLS3A24X36-RM
PCH012J	MK1070JB	BT7S2ABV0M	HLMH790-RM	10022-XL-RM	DLS3A24X36L

• Edited by A_Shannon828 Tuesday, May 12, 2015 6:46 PM

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Tuesday, May 12, 2015 7:00 PM

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Tuesday, May 12, 2015 7:00 PM

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Tuesday, May 12, 2015 7:00 PM

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Tuesday, May 12, 2015 7:00 PM

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Tuesday, May 12, 2015 7:00 PM

Sub Test()

For Each C In Range("A2:A16000")

If Left(C.Value,3)= "PCH" Then C.Value = "Pouch"

If Left(C.Value,2)= "MK" Then C.Value = "Maverick Vision"

If Left(C.Value,4)= "HLMH" Then C.Value = "Helmet"

If Left(C.Value,5)= "10022" Then C.Value = "Plate"

If Left(C.Value,3)= "DLS" Then C.Value = "Shield"

Next C

End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Tuesday, May 12, 2015 7:00 PM

Hi A_Shannon828,

Base on your description, you want to work with VBA. Please try the method of Bernie Deitrick, Excel MVP 2000-2010, check if it works fine.

If you need more help with VBA, you can post your issue in MSDN forum for Excel.

http://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev&filter=alltypes&sort=lastpostdesc

The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.

Regards,

George Zhao
TechNet Community Support

Thanks again Bernie!

I'm trying to get it to adapt to the number of cells because I'm going to be using it with sales orders and will not have a specific range.  I only want it to work with cells that are used. This is what I currently have for the cell:

Sub RenameItem()

    'need to detect and use only cells with text

>>>For Each Item In Range(Range("H2"), Range("H2").End(xlDown)).Select

If Left(Item.Value, 3) = "PCH" Then Item.Value = "Pouch"
If Left(Item.Value, 2) = "MK" Then Item.Value = "Maverick"
If Left(Item.Value, 2) = "BT" Then Item.Value = "Vision"
If Left(Item.Value, 4) = "HLMH" Then Item.Value = "Helmet"
If Left(Item.Value, 5) = "10022" Then Item.Value = "Plate"
If Left(Item.Value, 2) = "DL" Then Item.Value = "Shield"

Next Item

End Sub

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor 16 hours 29 minutes ago

You can try also the tactics I suggested in:

http://answers.microsoft.com/en-us/office/forum/office_2003-excel/converting-state-name-to-2-letters/7714ab99-b0d4-4a1d-86e5-ec58e5771cbc

Regards

PB

Perfect, Thanks :) 

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM
• Marked as answer by A_Shannon828 16 hours 5 minutes ago

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Sub RenameItem()
    'need to detect and use only cells with text

    Dim rItem As Range

    For Each rItem In Range(Range("H2"), Range("H2").End(xlDown))
        If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
        If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
        If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
        If Left(rItem.Value, 4) = "HLMH" Then rItem.Value = "Helmet"
        If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
        If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    Next rItem
End Sub

    

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 13, 2015 3:01 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Sorry to bother you again Bernie, but is it possible to take the sales order number, specified items and tallied quantity and reduce it to a single line?  Below is a small sample data set and below that I will post what im trying to accomplish

Sales Order Num	Item	QTY
SOF-3164220	IDPN00310C	4
	Pouch	1
	Pouch	1
	Pouch	1
	Pouch	1
	RD3N00200C	1
SOF-3164221	IDPN00310J	8
	OS1N00BV0J	4
SOF-3164222	VS2AXDKA0M	1
	VS2AXDKATM	1
SOF-3164223	PY3DXAKA0M	1
	QC2N00BV0Q	1

Desired Output

Sales Order           Items 

SOF-3164220        4-Pouch, 1-RD3N00200C

And im trying to get my macro to do this for a large volume of open sales orders of varying sizes.  Also I just want to let you know im quite new to visual basic so if you have any recommended reading material with regard to excel, I would greatly appreciate it.  Thanks

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor 15 hours 47 minutes ago

Yes that's exactly what I'm trying to do, certain items that I have yet to be told will be omitted though.  I believe that I am going to have to create a loop for each individual sales order, I just don't know how to go about accomplishing it.

And thanks for the book recommendation, ill have to pick it up.

• Edited by A_Shannon828 15 hours 22 minutes ago

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor 14 hours 53 minutes ago

Thank you so much!  it functions exactly how I was wanting it to work.  now I just need to adjust the sheets and ranges for it to work where I want it to work which I should be able to do.

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 3:43 PM

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 3:43 PM

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 3:43 PM
• Marked as answer by A_Shannon828 16 hours 4 minutes ago

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 3:43 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 3:43 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Would you want the QTY taken into account?

Instead of

SOF-3164220        4-Pouch, 1-RD3N00200C

Sales Order Num    Item            

SOF-3164220     4-IDPN00310C, 4-Pouch, 1-RD3N00200C

SOF-3164221     8-IDPN00310J, 4-OS1N00BV0J

As for reading, I always recommend John Walkenbach's Excel XXXX Power Programming with VBA - look for XXXX with your version, or buy an older used copy for an out-of-date version, since the basics remain the same.

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 3:43 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Yes that's exactly what I'm trying to do, certain items that I have yet to be told will be omitted though.  I believe that I am going to have to create a loop for each individual sales order, I just don't know how to go about accomplishing it.

And thanks for the book recommendation, ill have to pick it up.

• Edited by A_Shannon828 Thursday, May 14, 2015 4:09 PM

Yes that's exactly what I'm trying to do, certain items that I have yet to be told will be omitted though.  I believe that I am going to have to create a loop for each individual sales order, I just don't know how to go about accomplishing it.

And thanks for the book recommendation, ill have to pick it up.

• Edited by A_Shannon828 Thursday, May 14, 2015 4:09 PM

Yes that's exactly what I'm trying to do, certain items that I have yet to be told will be omitted though.  I believe that I am going to have to create a loop for each individual sales order, I just don't know how to go about accomplishing it.

And thanks for the book recommendation, ill have to pick it up.

• Edited by A_Shannon828 Thursday, May 14, 2015 4:09 PM

Yes that's exactly what I'm trying to do, certain items that I have yet to be told will be omitted though.  I believe that I am going to have to create a loop for each individual sales order, I just don't know how to go about accomplishing it.

And thanks for the book recommendation, ill have to pick it up.

• Edited by A_Shannon828 Thursday, May 14, 2015 4:09 PM

Yes that's exactly what I'm trying to do, certain items that I have yet to be told will be omitted though.  I believe that I am going to have to create a loop for each individual sales order, I just don't know how to go about accomplishing it.

And thanks for the book recommendation, ill have to pick it up.

• Edited by A_Shannon828 Thursday, May 14, 2015 4:09 PM

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 4:38 PM

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 4:38 PM

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 4:38 PM
• Marked as answer by A_Shannon828 16 hours 4 minutes ago

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 4:38 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 4:38 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Try this macro on a copy of your worksheet - select one cell (the one with SOF-3164220 from your example) when prompted:

                                              

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Thursday, May 14, 2015 4:38 PM
• Marked as answer by A_Shannon828 Monday, May 18, 2015 3:23 PM

Sorry to bother you again Bernie.  I just have a question about your code.

What lines indicate which columns to add?  For instance, I was told to add more items to the output from each sales order such as date, number of days, aggregation color and sum the amount per item.

Sales num	Item	QTY	Sales Date	Days	Customer	Agg Color	Price of Item
SOF-3164222	VS2AXDKA0M	1	05/06/15	5	LAWM01 - LAWMEN SUPPLY CO. OF NJ, INC.	(blank)	664.6
	VS2AXDKATM	1				(blank)	728.74
SOF-3164223	PY3DXAKA0M	1	05/06/15	5	BUCKEMEQ - BUCKSHOLLOW EMERGENCY EQUIPMENT	(blank)	507.875
	QC2N00BV0Q	1				(blank)	95.62
SOF-3164224	IDPN00310C	4	05/06/15	5	GAL050 - GALL'S INC.	(blank)	0
	Pouch	1				(blank)	12.9
	Pouch	1				(blank)	17.2
	Pouch	1				(blank)	17.2
	Pouch	1				(blank)	8.6
	RD3N00200C	1				(blank)	0

Everything is keyed off the column with the Sales num, using  r.Offset(0, 1) (which is the next column to the right) and r.Offset(0, 2)  (which is the second column to the right) 

So, to get the cost, you would use r.offset(0,6) (price) multiplied by r.offset(0,2) (quantity)

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor 16 hours 40 minutes ago

Everything is keyed off the column with the Sales num, using  r.Offset(0, 1) (which is the next column to the right) and r.Offset(0, 2)  (which is the second column to the right) 

So, to get the cost, you would use r.offset(0,6) (price) multiplied by r.offset(0,2) (quantity)

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Friday, May 15, 2015 2:50 PM

Everything is keyed off the column with the Sales num, using  r.Offset(0, 1) (which is the next column to the right) and r.Offset(0, 2)  (which is the second column to the right) 

So, to get the cost, you would use r.offset(0,6) (price) multiplied by r.offset(0,2) (quantity)

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Friday, May 15, 2015 2:50 PM

Everything is keyed off the column with the Sales num, using  r.Offset(0, 1) (which is the next column to the right) and r.Offset(0, 2)  (which is the second column to the right) 

So, to get the cost, you would use r.offset(0,6) (price) multiplied by r.offset(0,2) (quantity)

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Friday, May 15, 2015 2:50 PM

Everything is keyed off the column with the Sales num, using  r.Offset(0, 1) (which is the next column to the right) and r.Offset(0, 2)  (which is the second column to the right) 

So, to get the cost, you would use r.offset(0,6) (price) multiplied by r.offset(0,2) (quantity)

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Friday, May 15, 2015 2:50 PM

Everything is keyed off the column with the Sales num, using  r.Offset(0, 1) (which is the next column to the right) and r.Offset(0, 2)  (which is the second column to the right) 

So, to get the cost, you would use r.offset(0,6) (price) multiplied by r.offset(0,2) (quantity)

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Friday, May 15, 2015 2:50 PM

Have you tried once with Excel's AutoCorrect Feature. I am not sure that it will solve your problem. But in your case you should start researching with AutoCorrect first. If it is not satisfactory then you can opt for customized feauture,

Bernie, I'm sorry but I think I didn't say what I meant to say

What I meant, is that I need to sum the amount column for each sales order after I multiply the QTY by price and return it on one line similarly to generating the list of items.

Thanks again for all of your help

I think I understand. Try changing the second sub to

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.Evaluate("=SumProduct((" & r.Offset(0, 1).Address & " = " & _
                c.Address & ") * (" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))") & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 7).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator 6 hours 16 minutes ago

That added the total to the list of items.  I think it would be easier to handle the multiplication with a pivot table so all I would need to do is sum the far right column by sales order so that it is in one cell rather than one for each sales item

Raw Data:

SOF-3164222	VS2AXDKA0M	1	05/06/15	5	LAWM01 - LAWMEN SUPPLY CO. OF   NJ, INC.	(blank)	664.6
	VS2AXDKATM	1				(blank)	728.74
SOF-3164223	PY3DXAKA0M	1	05/06/15	5	BUCKEMEQ - BUCKSHOLLOW EMERGENCY EQUIPMENT	(blank)	507.875
	QC2N00BV0Q	1				(blank)	95.62

Desired output (..... used to skip, disregard):
SOF-3164222................................................................................$1393.34

SOF-3164223................................................................................$603.50

I think I see now - try:

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    r.Cells(1).Offset(0, 7).Value = Application.Evaluate("=SumProduct((" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))")
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 8).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 13 hours 7 minutes ago

Perfect!  Thank you so much for all of your help.

I think I understand. Try changing the second sub to

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.Evaluate("=SumProduct((" & r.Offset(0, 1).Address & " = " & _
                c.Address & ") * (" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))") & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 7).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Tuesday, May 19, 2015 1:12 AM

I think I understand. Try changing the second sub to

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.Evaluate("=SumProduct((" & r.Offset(0, 1).Address & " = " & _
                c.Address & ") * (" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))") & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 7).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Tuesday, May 19, 2015 1:12 AM

I think I understand. Try changing the second sub to

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.Evaluate("=SumProduct((" & r.Offset(0, 1).Address & " = " & _
                c.Address & ") * (" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))") & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 7).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Tuesday, May 19, 2015 1:12 AM

I think I see now - try:

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    r.Cells(1).Offset(0, 7).Value = Application.Evaluate("=SumProduct((" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))")
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 8).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 Monday, May 18, 2015 6:21 PM

I think I see now - try:

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    r.Cells(1).Offset(0, 7).Value = Application.Evaluate("=SumProduct((" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))")
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 8).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 Monday, May 18, 2015 6:21 PM

I think I see now - try:

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    r.Cells(1).Offset(0, 7).Value = Application.Evaluate("=SumProduct((" & r.Offset(0, 2).Address & "*" & _
                r.Offset(0, 7).Address & "))")
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 8).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 Monday, May 18, 2015 6:21 PM

Sorry to bother you again.  When I combine all of the macros into one executable button I cannot get the text conversion part to work for the entire 30,000 items (which varies based on the days data) in the column.  It converts the first three (that are indicated in the if statements) but I'm lost as to what to adjust to set it to go all the way down aside from physically setting a set value instead of the second b5.

  'Rename ID to Items in Item Col

Sub RenameItem()

    Dim rItem As Range

     For Each rItem In Sheets("Testing_Data").Range(Range("B5"), Sheets("Testing_Data").Range("B5").End(xlDown))
        
         If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
         If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
         If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
         If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
         If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
         If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    
     Next rItem
    
    
 End Sub

Thank you,

Andrew

• Edited by A_Shannon828 16 hours 25 minutes ago forgot to mention something

Andrew,

You must have a blank cell somewhere in column B that is intercepting your xlDown, so a better approach is to go from the bottom up (and make sure you are working on the correct sheet):

Sub RenameItem()
    
    Dim rItem As Range
    With Sheets("Testing_Data")
        For Each rItem In .Range(.Range("B5"), .Cells(.Rows.Count, "B").End(xlUp))
            If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
            If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
            If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
            If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
            If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
            If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
        Next rItem
    End With
     
End Sub

• Marked as answer by A_Shannon828 15 hours 22 minutes ago

Ah, ok.  Thanks, I think I understand how the xlup and xldown functions now.

Would it be faster or more efficient to use xlup to copy and paste a range of cells than a relative range such as A1:100000? 

It can be, since it finds just the cells you are using.  Certainly, if you are doing a line by line process, it is much better to limit your processing to the used cells.

Sorry to bother you again.  When I combine all of the macros into one executable button I cannot get the text conversion part to work for the entire 30,000 items (which varies based on the days data) in the column.  It converts the first three (that are indicated in the if statements) but I'm lost as to what to adjust to set it to go all the way down aside from physically setting a set value instead of the second b5.

  'Rename ID to Items in Item Col

Sub RenameItem()

    Dim rItem As Range

     For Each rItem In Sheets("Testing_Data").Range(Range("B5"), Sheets("Testing_Data").Range("B5").End(xlDown))
        
         If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
         If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
         If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
         If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
         If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
         If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    
     Next rItem
    
    
 End Sub

Thank you,

Andrew

• Edited by A_Shannon828 Tuesday, May 19, 2015 3:08 PM forgot to mention something

Sorry to bother you again.  When I combine all of the macros into one executable button I cannot get the text conversion part to work for the entire 30,000 items (which varies based on the days data) in the column.  It converts the first three (that are indicated in the if statements) but I'm lost as to what to adjust to set it to go all the way down aside from physically setting a set value instead of the second b5.

  'Rename ID to Items in Item Col

Sub RenameItem()

    Dim rItem As Range

     For Each rItem In Sheets("Testing_Data").Range(Range("B5"), Sheets("Testing_Data").Range("B5").End(xlDown))
        
         If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
         If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
         If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
         If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
         If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
         If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    
     Next rItem
    
    
 End Sub

Thank you,

Andrew

• Edited by A_Shannon828 Tuesday, May 19, 2015 3:08 PM forgot to mention something

Sorry to bother you again.  When I combine all of the macros into one executable button I cannot get the text conversion part to work for the entire 30,000 items (which varies based on the days data) in the column.  It converts the first three (that are indicated in the if statements) but I'm lost as to what to adjust to set it to go all the way down aside from physically setting a set value instead of the second b5.

  'Rename ID to Items in Item Col

Sub RenameItem()

    Dim rItem As Range

     For Each rItem In Sheets("Testing_Data").Range(Range("B5"), Sheets("Testing_Data").Range("B5").End(xlDown))
        
         If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
         If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
         If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
         If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
         If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
         If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
    
     Next rItem
    
    
 End Sub

Thank you,

Andrew

• Edited by A_Shannon828 Tuesday, May 19, 2015 3:08 PM forgot to mention something

Andrew,

You must have a blank cell somewhere in column B that is intercepting your xlDown, so a better approach is to go from the bottom up (and make sure you are working on the correct sheet):

Sub RenameItem()
    
    Dim rItem As Range
    With Sheets("Testing_Data")
        For Each rItem In .Range(.Range("B5"), .Cells(.Rows.Count, "B").End(xlUp))
            If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
            If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
            If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
            If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
            If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
            If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
        Next rItem
    End With
     
End Sub

• Marked as answer by A_Shannon828 Tuesday, May 19, 2015 4:11 PM

Andrew,

You must have a blank cell somewhere in column B that is intercepting your xlDown, so a better approach is to go from the bottom up (and make sure you are working on the correct sheet):

Sub RenameItem()
    
    Dim rItem As Range
    With Sheets("Testing_Data")
        For Each rItem In .Range(.Range("B5"), .Cells(.Rows.Count, "B").End(xlUp))
            If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
            If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
            If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
            If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
            If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
            If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
        Next rItem
    End With
     
End Sub

• Marked as answer by A_Shannon828 Tuesday, May 19, 2015 4:11 PM

Andrew,

You must have a blank cell somewhere in column B that is intercepting your xlDown, so a better approach is to go from the bottom up (and make sure you are working on the correct sheet):

Sub RenameItem()
    
    Dim rItem As Range
    With Sheets("Testing_Data")
        For Each rItem In .Range(.Range("B5"), .Cells(.Rows.Count, "B").End(xlUp))
            If Left(rItem.Value, 3) = "PCH" Then rItem.Value = "Pouch"
            If Left(rItem.Value, 2) = "MK" Then rItem.Value = "Maverick"
            If Left(rItem.Value, 2) = "BT" Then rItem.Value = "Vision"
            If Left(rItem.Value, 3) = "HLM" Then rItem.Value = "Helmet"
            If Left(rItem.Value, 5) = "10022" Then rItem.Value = "Plate"
            If Left(rItem.Value, 2) = "DL" Then rItem.Value = "Shield"
        Next rItem
    End With
     
End Sub

• Marked as answer by A_Shannon828 Tuesday, May 19, 2015 4:11 PM

I've got something sort of working for the copy and paste to use only cells that are filled but when I added a third column, only the second column (column H) would populate and im not quite sure why.

Sub PopulateData()
    
    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long
   
Set s1 = Sheets("Sample_Data")
Set s2 = Sheets("Testing_Data")

'Detects and copies col a

iLastRowS1 = s1.Cells(s1.Rows.Count, "A").End(xlUp).Row
Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

s1.Range("A6", s1.Cells(iLastRowS1, "A")).Copy

'Detects and copies col h

iLastRowS1 = s1.Cells(s1.Rows.Count, "H").End(xlUp).Row
Set iLastCellS2 = s2.Cells(s2.Rows.Count, "B").End(xlUp).Offset(1, 0)

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

End Sub()

iLastCellS2 is a single cell - and you are only copying a single column.

If you want to copy two (or three, or more) columns, then just extend the copy range by changing "H" to "I"

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

s1.Range("H6", s1.Cells(iLastRowS1, "I")).Copy iLastCellS2

If you want to paste a single column over two columns, then expand the target of the paste:

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2.Resize(1,2)

IF that isn't what you want to do, post back with an explanation of what you want rather than what code you have that does not work.

• Marked as answer by A_Shannon828 12 hours 9 minutes ago

Thanks for your help again! 

What im doing is selecting certain columns from a large database, running calculations and printing it to a separate worksheet.

Is it possible to paste with destination formatting if I am using this method to move data?

Move data, or copy data?

Copying while retaining destination formatting: change the one line

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

to two lines

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy

iLastCellS2.PasteSpecial xlPasteValues

Moving while retaining destination formatting means copying just the formatting from an appropriate block of cells after the move and pastespecial using xlPasteFormats

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor 11 hours 49 minutes ago
• Marked as answer by A_Shannon828 10 hours 26 minutes ago

iLastCellS2 is a single cell - and you are only copying a single column.

If you want to copy two (or three, or more) columns, then just extend the copy range by changing "H" to "I"

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

s1.Range("H6", s1.Cells(iLastRowS1, "I")).Copy iLastCellS2

If you want to paste a single column over two columns, then expand the target of the paste:

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2.Resize(1,2)

IF that isn't what you want to do, post back with an explanation of what you want rather than what code you have that does not work.

• Marked as answer by A_Shannon828 Wednesday, May 20, 2015 7:22 PM

iLastCellS2 is a single cell - and you are only copying a single column.

If you want to copy two (or three, or more) columns, then just extend the copy range by changing "H" to "I"

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

s1.Range("H6", s1.Cells(iLastRowS1, "I")).Copy iLastCellS2

If you want to paste a single column over two columns, then expand the target of the paste:

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2.Resize(1,2)

IF that isn't what you want to do, post back with an explanation of what you want rather than what code you have that does not work.

• Marked as answer by A_Shannon828 Wednesday, May 20, 2015 7:22 PM

Move data, or copy data?

Copying while retaining destination formatting: change the one line

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

to two lines

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy

iLastCellS2.PasteSpecial xlPasteValues

Moving while retaining destination formatting means copying just the formatting from an appropriate block of cells after the move and pastespecial using xlPasteFormats

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 20, 2015 7:42 PM
• Marked as answer by A_Shannon828 Wednesday, May 20, 2015 9:05 PM

Move data, or copy data?

Copying while retaining destination formatting: change the one line

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy iLastCellS2

to two lines

s1.Range("H6", s1.Cells(iLastRowS1, "H")).Copy

iLastCellS2.PasteSpecial xlPasteValues

Moving while retaining destination formatting means copying just the formatting from an appropriate block of cells after the move and pastespecial using xlPasteFormats

• Edited by Bernie Deitrick, Excel MVP 2000-2010Microsoft community contributor Wednesday, May 20, 2015 7:42 PM
• Marked as answer by A_Shannon828 Wednesday, May 20, 2015 9:05 PM

I'm sorry to bug you again, but I have a question about the code that you had given me earlier (ill post it below).  I think I accidently changed something because now for what ever reason it is combining the bottom two sales orders into the same line.  the first 19,999 run fine, its just the very last order that gets messed up.

Example

SOF-3163030	AE1AXAKA0W	1
SOF-3163031	SD2N00010P	2

Should look like

SOF-3163030	1-AE1AXAKA0W
SOF-3163031	2-SD2N00010P

The actual output looks like this:

SOF-3163030

1-AE1AXAKA0W, 2-SD2N00010P

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by A_Shannon828 12 hours 30 minutes ago

It was an issue if the second to last sales order only had one item:

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    If rngA.Cells.Count > 1 Then
        MakeList Range(rngA.Cells(rngA.Cells.Count), rngL.Cells(rngL.Cells.Count))
        For j = rngA.Cells.Count - 1 To 1 Step -1
            MakeList rngA.Cells(j)
        Next j
    Else
        MakeList Range(rngA, rngL.Cells(rngL.Cells.Count))
    End If
    
    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
            For j = 1 To rngS.Areas(i).Cells.Count - 1
                MakeList rngS.Areas(i).Cells(j)
            Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 10 hours 47 minutes ago

I'm sorry to bug you again, but I have a question about the code that you had given me earlier (ill post it below).  I think I accidently changed something because now for what ever reason it is combining the bottom two sales orders into the same line.  the first 19,999 run fine, its just the very last order that gets messed up.

Example

SOF-3163030	AE1AXAKA0W	1
SOF-3163031	SD2N00010P	2

Should look like

SOF-3163030	1-AE1AXAKA0W
SOF-3163031	2-SD2N00010P

The actual output looks like this:

SOF-3163030

1-AE1AXAKA0W, 2-SD2N00010P

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by A_Shannon828 Friday, May 22, 2015 7:00 PM

I'm sorry to bug you again, but I have a question about the code that you had given me earlier (ill post it below).  I think I accidently changed something because now for what ever reason it is combining the bottom two sales orders into the same line.  the first 19,999 run fine, its just the very last order that gets messed up.

Example

SOF-3163030	AE1AXAKA0W	1
SOF-3163031	SD2N00010P	2

Should look like

SOF-3163030	1-AE1AXAKA0W
SOF-3163031	2-SD2N00010P

The actual output looks like this:

SOF-3163030

1-AE1AXAKA0W, 2-SD2N00010P

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    Set rngA = Range(rngS.Areas(c), rngL.Cells(rngL.Cells.Count))
    MakeList rngA

    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
        For j = 1 To rngS.Areas(i).Cells.Count - 1
            MakeList rngS.Areas(i).Cells(j)
        Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Edited by A_Shannon828 Friday, May 22, 2015 7:00 PM

It was an issue if the second to last sales order only had one item:

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    If rngA.Cells.Count > 1 Then
        MakeList Range(rngA.Cells(rngA.Cells.Count), rngL.Cells(rngL.Cells.Count))
        For j = rngA.Cells.Count - 1 To 1 Step -1
            MakeList rngA.Cells(j)
        Next j
    Else
        MakeList Range(rngA, rngL.Cells(rngL.Cells.Count))
    End If
    
    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
            For j = 1 To rngS.Areas(i).Cells.Count - 1
                MakeList rngS.Areas(i).Cells(j)
            Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 Friday, May 22, 2015 8:43 PM

It was an issue if the second to last sales order only had one item:

Sub TestMacro()
    Dim rngC As Range
    Dim rngA As Range
    Dim rngL As Range
    Dim i As Integer
    Dim c As Integer
    Dim j As Integer
    Dim rngS As Range
    Dim rAnchor As Range

    Set rAnchor = Application.InputBox("Pick the cell with the first sales order number", Type:=8)

    Set rngL = Range(rAnchor, Cells(Rows.Count, rAnchor.Column + 1).End(xlUp)(1, 0))

    Set rngS = rngL.SpecialCells(xlCellTypeConstants)

    c = rngS.Areas.Count
    Set rngA = rngS.Areas(c)

    If rngA.Cells.Count > 1 Then
        MakeList Range(rngA.Cells(rngA.Cells.Count), rngL.Cells(rngL.Cells.Count))
        For j = rngA.Cells.Count - 1 To 1 Step -1
            MakeList rngA.Cells(j)
        Next j
    Else
        MakeList Range(rngA, rngL.Cells(rngL.Cells.Count))
    End If
    
    For i = c - 1 To 1 Step -1
        Set rngA = rngS.Areas(i)
        Set rngA = Range(rngA.Cells(rngA.Cells.Count), rngS.Areas(i + 1).Cells(0))
        MakeList rngA
        If rngS.Areas(i).Cells.Count > 1 Then
            For j = 1 To rngS.Areas(i).Cells.Count - 1
                MakeList rngS.Areas(i).Cells(j)
            Next j
        End If

    Next i

    rAnchor.Resize(1, 2).EntireColumn.AutoFit
    rAnchor.Offset(0, 2).EntireColumn.Delete

End Sub

Sub MakeList(r As Range)
    Dim c As Range
    Dim strV As String
    For Each c In r.Offset(0, 1)
        If Application.CountIf(Range(r.Cells(1), c), c) = 1 Then
            strV = strV & IIf(strV <> "", ", ", "") & _
                Application.SumIf(r.Offset(0, 1), c, r.Offset(0, 2)) & "-" & c.Value
        End If
    Next c
    r.Cells(1).Offset(0, 1).Value = strV
    If r.Cells.Count > 1 Then
        r.Cells(2).Resize(r.Cells.Count - 1, 3).Delete xlUp
    End If
    r.Cells(1, 3).ClearContents
End Sub

• Marked as answer by A_Shannon828 Friday, May 22, 2015 8:43 PM