VBA Extracting Data whilst moving cells to be in correct format

Grange2

New Member
Joined
Mar 31, 2021
Messages
14
Office Version
  1. 2013
  2. 2011
Platform
  1. Windows
Hello,

Im looking to extract data from copied data.
*3840113WILLOCHRAHOMEFORTHEAGED
53292A10(3)SPAGHETTISPKX57163710.300.3
61651420G(24)SPAGHETTIKX60210630.1500.15
61659425G(24)BAKEDBEANKX46300140.200.2
61659425G(24)BAKEDBEANKX60210650.2500.25
89228A10(3)PEARSLICESKX67283811.201.2
89244A10(3)PEACHSLICESKX53025011.201.2
89244A10(3)PEACHSLICESKX60210611.201.2
89252A10(3)PEACHHALVESKX67283811.201.2
243566120GX24APPLEAPRICKX67283818.2508.25
243567120GX24APPLEPEACHKX39379918.2508.25
243567120GX24APPLEPEACHKX46300118.2508.25
243567120GX24APPLEPEACHKX60210618.2508.25
243618120GX24APPLESTRAWKX53025018.2508.25
*3840120BONEHAMAGEDCARESERVICES
63175A10(3)DICEDPIEPEKX40157932.402.4
63175A10(3)DICEDPIEPEKX54987432.402.4
63175A10(3)DICEDPIEPEKX68095232.402.4
89228A10(3)PEARSLICESKX47022433.603.6
90624A10(3)APPLEANDSTKX60978410.600.6
*3840465NORTHEASTERNCOMMUNITY
61651420G(24)SPAGHETTIKX60361250.2500.25
61659425G(24)BAKEDBEANKX39308760.300.3
61659425G(24)BAKEDBEANKX50290180.400.4
61659425G(24)BAKEDBEANKX603612120.600.6
61659425G(24)BAKEDBEANKX71802550.2500.25
90623A10(3)APPLEANDPEKX46193731.804
90623A10(3)APPLEANDPEKX57435331.808
90623A10(3)APPLEANDPEKX67326631.801
90625A10(3)TROPICALFRUKX50290131.801.8
*3841541CORRECTIVESERVICESNSW
53284A10(3)BAKEDBEANSKX49808630.900.9
53284A10(3)BAKEDBEANSKX53856630.900.9
53292A10(3)SPAGHETTISPKX38828230.900.9
*3842718WHEATFIELDSINCORPORATED
298652.95K(3)PEARANDMKX64666010.605
63175A10(3)DICEDPIEPEKX53139232.405
89228A10(3)PEARSLICESKX57458433.603.6


What im looking is to move all the Values beginning with KX end up in the same column (E). I don't require the names of the items (columns B:D). The biggest issue is that some KX values show in column D and some begin in Column F. If it could end up looking like this it would be perfect for my needs.

*3840113WILLOCHRAHOMEFORTHEAGED
53292A10(3)SPAGHETTISPKX57163710.300.3
61651420G(24)SPAGHETTIKX60210630.1500.15
61659425G(24)BAKEDBEANKX46300140.200.2
61659425G(24)BAKEDBEANKX60210650.2500.25
89228A10(3)PEARSLICESKX67283811.201.2
89244A10(3)PEACHSLICESKX53025011.201.2
89244A10(3)PEACHSLICESKX60210611.201.2
89252A10(3)PEACHHALVESKX67283811.201.2
243566120GX24APPLEAPRICKX67283818.2508.25
243567120GX24APPLEPEACHKX39379918.2508.25
243567120GX24APPLEPEACHKX46300118.2508.25
243567120GX24APPLEPEACHKX60210618.2508.25
243618120GX24APPLESTRAWKX53025018.2508.25
*3840120BONEHAMAGEDCARESERVICES
63175A10(3)DICEDPIEKX40157932.402.4
63175A10(3)DICEDPIEKX54987432.402.4
63175A10(3)DICEDPIEKX68095232.402.4
89228A10(3)PEARSLICESKX47022433.603.6
90624A10(3)APPLEANDKX60978410.600.6
*3840465NORTHEASTERNCOMMUNITY
61651420G(24)SPAGHETTIKX60361250.2500.25
61659425G(24)BAKEDBEANKX39308760.300.3
61659425G(24)BAKEDBEANKX50290180.400.4
61659425G(24)BAKEDBEANKX603612120.600.6
61659425G(24)BAKEDBEANKX71802550.2500.25
90623A10(3)APPLEANDKX46193731.804
90623A10(3)APPLEANDKX57435331.808
90623A10(3)APPLEANDKX67326631.801
90625A10(3)TROPICALFRUKX50290131.801.8
*3841541CORRECTIVESERVICESNSW
53284A10(3)BAKEDBEANSKX49808630.900.9
53284A10(3)BAKEDBEANSKX53856630.900.9
53292A10(3)SPAGHETTISPKX38828230.900.9
*3842718WHEATFIELDSINCORPORATED
298652.95K(3)PEARANDKX64666010.605
63175A10(3)DICEDPIEKX53139232.405
89228A10(3)PEARSLICESKX57458433.603.6


Any help would be greatly appreciated!

Thank you.
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Try This
VBA Code:
Sub ReAlign()

Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set rngData = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    ws1.Range("A" & cell.Row, "J" & cell.Row).Copy ws2.Range("A" & cell.Row)
    If Left(ws2.Range("D" & cell.Row), 2) = "KX" Then
        ws2.Range("D" & cell.Row).Insert xlShiftToRight
    ElseIf Left(ws2.Range("F" & cell.Row), 2) = "KX" Then
        ws2.Range("E" & cell.Row).Delete xlShiftToLeft
    End If
Next

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

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