Auto Selective data column mover

B

binar

Board Regular
Joined
Aug 20, 2006
Messages
71
Fellow Forum Members,

In columns A and B, I have a list of 800 part number titles with corresponding description data in between each title. In other words, Cell A1 contains the Title "Part Number" and cell A2 contains the part number "23495B34" followed by several rows of parts description data and then followed by the next of 800 part number titles.

My goal is to filter out every occurance of the the Part Number Titles from the description data and move it over to columns C and D. The built in Excel 2007 filter is not able to do this.

Can anyone out there help me out with a function or macro that will select and CUT every occurance of the word "Part Number" (located in column A#) as well as the accompanying part number itself (i.e., "23495B34") (located in column B#) right beside the word "Part Number". Once all this data is in the clipboard I want to click on a cell in column C and paste.

What I'm seeking to get is only the part number titles still on the same original rows but now in columns C and D and minus the part number description data.

It would be cool if the built in Excel 2007 Filter feature allowed one to paste data when the filter is active but this is not allowed.

Any help will be greatly appreciated.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
binar,

What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net
 
Upvote 0
Hiker95, thanks for all the posting tips. My version of Excel is 2007. Below is a sample file I uploaded to box net:

http://www.box.net/shared/l9zz82dvzk

The sample file shows a Before and After tab. My goal is to cut and move two cells of data over two columns to the right as long as it meets the condition of matching the word "PART NUMBER:". Next time I'll try including a screenshot. Thanks for the help
 
Upvote 0
binar,

every occurance of the the Part Number Titles from the description data and move it over to columns C and D. The built in Excel 2007 filter is not able to do this.
Click to expand...

This description does not match tbe Before and After worksheets. I went with the worksheet After results. If the macro needs to be changed, let me know.


Sample data before the macro:


Excel Workbook
ABCDEF
3
4PART NUMBER:3459B20
5Cost:$456
6Manufacturer:XYZ
7Type:Class 1
8Warranty:4 years
9Profit Margin:30%
10Supplier1:XYZ
11Supplier2:RTY
12Drawing #:3840
13
14PART NUMBER:245A66
15Cost:$39
16Manufacturer:RTF
17Type:Class @
18Warranty:2 years
19Profit Margin:30%
20Supplier1:XYZ
21Supplier2:HRT
22Drawing #:33452
23
24PART NUMBER:62T366
25Cost:$234
26Manufacturer:WER
27Type:Class 5
28Warranty:5 years
29Profit Margin:30%
30Supplier1:HFRT
31Supplier2:DED
32Drawing #:642456
33
BEFORE





After the macro:


Excel Workbook
ABCDEF
3
4PART NUMBER:3459B20
5Cost:$456
6Manufacturer:XYZ
7Type:Class 1
8Warranty:4 years
9Profit Margin:30%
10Supplier1:XYZ
11Supplier2:RTY
12Drawing #:3840
13
14PART NUMBER:245A66
15Cost:$39
16Manufacturer:RTF
17Type:Class @
18Warranty:2 years
19Profit Margin:30%
20Supplier1:XYZ
21Supplier2:HRT
22Drawing #:33452
23
24PART NUMBER:62T366
25Cost:$234
26Manufacturer:WER
27Type:Class 5
28Warranty:5 years
29Profit Margin:30%
30Supplier1:HFRT
31Supplier2:DED
32Drawing #:642456
33
BEFORE





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code: 
Option Explicit
Sub MovePartNbr()
' hiker95, 04/26/2011
' http://www.mrexcel.com/forum/showthread.php?t=546224
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
  If c = "PART NUMBER:" Then
    c.Resize(, 2).Copy c.Offset(, 4)
    c.Resize(, 2).Clear
  End If
Next c
Columns("E:F").AutoFit
Application.ScreenUpdating = True
End Sub



Before you run the macro, save your workbook, Save As, a macro enambled workbook with file extension .xlsm


Then run the MovePartNbr macro.[/b]
 
Upvote 0
Hiker95,
A sincere thank you for your help in developing this macro. It works PERFECTLY! Evenmore, by playing around with your code I found out that I could move other labels as well just by changing the PART NUMBER: code to something like TYPE:

In my opinion, I think it is a shame the FILTER feature in Excel 2007 does not give us the ability to move data around when a FILTER is active. However, thanks to your code I now have the ability to filter data and move it while staying on the same worksheet.

Lastly, there is one tweak to your code that would be awesome if you can do it. Once in a great while the "PART NUMBER:" data is given to me in this format: "PART NUMBER 123456:"

In other words, the LABEL and Part number itself are combined into one cell. I tried adding to the line below a general expression in the hopes that it can find any six digit number combined with the label and then move the whole thing over a couple of columns. However it does not work.

If c = "PART NUMBER [0-9][0-9][0-9][0-9][0-9][0-9]:" Then

If you can show me how to make this change I would be very grateful. Thanks.
 
Last edited:
Upvote 0
binar,

So that we can get it right the first time:

Can we have another workbook?

Or, can we have screenshots?

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net
 
Last edited:
Upvote 0
Hiker95, I have to apologize for forgetting to post a new link:

http://www.box.net/shared/7dfscbvmb3

Also sorry that I forgot that the "PART NUMBER:" label format differs when an Alternate part number exists. Can the code be tweaked to include a search for any "PART NUMBER" label followed by a space and any number between 4 and 9 digits long as well just the "PART NUMBER:" label alone? For example: "PART NUMBER:" and/or "PART NUMBER #########:"

As my previous post shows trying to add a general expression such as:

"PART NUMBER [0-9][0-9][0-9][0-9][0-9][0-9]:"

does not work. Any help will be greatly appreciated. Thanks again.
 
Upvote 0
binar,


Sample data before the updated macro:


Excel Workbook
ABCDEF
1
2BEFORE
3
4PART NUMBER 954825:ALT: 524856
5Cost:$456
6Manufacturer:XYZ
7Type:Class 1
8Warranty:4 years
9Profit Margin:30%
10Supplier1:XYZ
11Supplier2:RTY
12Drawing #:3840
13
14PART NUMBER 85467:ALT: 58265A
15Cost:$39
16Manufacturer:RTF
17Type:Class @
18Warranty:2 years
19Profit Margin:30%
20Supplier1:XYZ
21Supplier2:HRT
22Drawing #:33452
23
24PART NUMBER 7845:ALT: 62T366
25Cost:$234
26Manufacturer:WER
27Type:Class 5
28Warranty:5 years
29Profit Margin:30%
30Supplier1:HFRT
31Supplier2:DED
32Drawing #:642456
33
34PART NUMBER:ALT: 62T366
35Cost:$234
36Manufacturer:WER
37Type:Class 5
38Warranty:5 years
39Profit Margin:30%
40Supplier1:HFRT
41Supplier2:DED
42Drawing #:642456
43
Sheet1





After the macro (new approach and faster):


Excel Workbook
ABCDEF
1
2BEFORE
3
4PART NUMBER 954825:ALT: 524856
5Cost:$456
6Manufacturer:XYZ
7Type:Class 1
8Warranty:4 years
9Profit Margin:30%
10Supplier1:XYZ
11Supplier2:RTY
12Drawing #:3840
13
14PART NUMBER 85467:ALT: 58265A
15Cost:$39
16Manufacturer:RTF
17Type:Class @
18Warranty:2 years
19Profit Margin:30%
20Supplier1:XYZ
21Supplier2:HRT
22Drawing #:33452
23
24PART NUMBER 7845:ALT: 62T366
25Cost:$234
26Manufacturer:WER
27Type:Class 5
28Warranty:5 years
29Profit Margin:30%
30Supplier1:HFRT
31Supplier2:DED
32Drawing #:642456
33
34PART NUMBER:ALT: 62T366
35Cost:$234
36Manufacturer:WER
37Type:Class 5
38Warranty:5 years
39Profit Margin:30%
40Supplier1:HFRT
41Supplier2:DED
42Drawing #:642456
43
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code: 
Option Explicit
Sub MovePartNbrV2()
' hiker95, 04/27/2011
' http://www.mrexcel.com/forum/showthread.php?t=546224
Dim Area As Range
Dim Sp, H As String
Application.ScreenUpdating = False
For Each Area In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    If InStr(Trim(Cells(.Row, 1)), "PART NUMBER") > 0 Then
      If Len(Trim(Cells(.Row, 1))) = 12 Then
        Cells(.Row, 1).Resize(, 2).Copy Cells(.Row, 1).Offset(, 4)
        Cells(.Row, 1).Resize(, 2).Clear
      ElseIf InStr(Cells(.Row, 1), " ") > 0 Then
        Sp = Split(Trim(Cells(.Row, 1)), "PART NUMBER ")
        If Right(Sp(1), 1) = ":" Then
          H = Left(Sp(1), Len(Sp(1)) - 1)
          If Len(H) >= 4 And Len(H) <= 9 Then
            Cells(.Row, 1).Resize(, 2).Copy Cells(.Row, 1).Offset(, 4)
            Cells(.Row, 1).Resize(, 2).Clear
          End If
        End If
      End If
    End If
  End With
Next Area
Columns("E:F").AutoFit
Application.ScreenUpdating = True
End Sub


Before you use the macro, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the MovePartNbrV2 macro.
 
Upvote 0
binar,

Same screenshots as my last reply.


Update to the latest macro (a little faster):


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code: 
Option Explicit
Sub MovePartNbrV3()
' hiker95, 04/28/2011
' http://www.mrexcel.com/forum/showthread.php?t=546224
Dim Area As Range
Dim Sp, H As String
Application.ScreenUpdating = False
For Each Area In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    If InStr(Trim(Cells(.Row, 1)), "PART NUMBER") > 0 Then
      If Len(Trim(Cells(.Row, 1))) = 12 Then
        Cells(.Row, 1).Resize(, 2).Cut Destination:=Cells(.Row, 1).Offset(, 4)
      ElseIf InStr(Cells(.Row, 1), " ") > 0 Then
        Sp = Split(Trim(Cells(.Row, 1)), "PART NUMBER ")
        If Right(Sp(1), 1) = ":" Then
          H = Left(Sp(1), Len(Sp(1)) - 1)
          If Len(H) >= 4 And Len(H) <= 9 Then
            Cells(.Row, 1).Resize(, 2).Cut Destination:=Cells(.Row, 1).Offset(, 4)
          End If
        End If
      End If
    End If
  End With
Next Area
Columns("E:F").AutoFit
Application.ScreenUpdating = True
End Sub


Before you use the macro, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the MovePartNbrV3 macro.
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
VBA - Match two values from Table1 to two in Table2 and move/align
2
Replies
15
Views
249
Welshy1491
W
K
  • Question Question
Filter and Unique missing data
Replies
5
Views
133
etaf
etaf
A
  • Solved
Using VBA to loop through multiple Word Templates and fill them in with Excel Data
2
Replies
14
Views
2K
John_w
J
ChrisMac1
  • Question Question
VBA - Compare specific data in one column on one sheet, with the same column on 4 other sheets, copy specific cells if match found.
Replies
1
Views
427
ChrisMac1
ChrisMac1
Z
  • Question Question
CHOOSECOLS Function + Format Data
Replies
1
Views
945
zero269
Z

Forum statistics

Threads
1,224,503
Messages
6,179,134
Members
452,890
Latest member
Nikhil Ramesh

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