IF / VBA help!

[heman334]

Hey, all i need to do is if column "A" has the number "1", "2", or "3", then select "B2 TO D2" cut it, paste at E1, THEN delete row 2. Etc....

See below:

My problem:

	A	B	C	D
1	1131700633	xxx	abc	10
2	1	aaa	1	a1
3	1131700634	xxx	abc	10
4	2	aaa	2	a2
5	1131700635	xxx	abc	11
6	1	aaa	3	a3

<tbody>
</tbody>

What it should look like

	A	B	C	D	E	F	G
1	1131700633	xxx	abc	10	aaa	1	a1
2	1131700634	xxx	abc	10	aaa	2	a2
3	1131700635	xxx	abc	11	aaa	3	a3

<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[hiker95]

heman334,

Thanks for the workbook.

Sample raw data in worksheet raw (not all columns are shown for brevity):

Excel 2007
	A	B	C	D	N	O	P	Q
1	Unit Number	Location	Operation Type	Timestamp	Housing pipe serial number (Barcode)	Housing Set (serial number)	Output Shim Size L.H. Calculated [mm]	Output Shim Size R.H. Calculated [mm]
2	1131700628	xxx	a	6/19/2013 7:01	S12061353
3	5	A0773113-	3	60	+286.000mm	+ 1000N	+308.001mm	+ 26000N
4	1131700629	xxx	a	6/19/2013 7:02	S12061353
5	5	A0773143-	3	54	+286.000mm	+ 1000N	+308.001mm	+ 26000N
6	1131700630	xxx	a	6/19/2013 7:03	S12061353
7	5	A0773153-	3	73	+286.000mm	+ 1000N	+308.001mm	+ 26000N
8	2131700636	xxx	Station worked OK	6/19/2013 7:07		A00586430G	3.25	3.65
9	2131700637	xxx	Station worked OK	6/19/2013 7:07		A00586530G	3.25	3.6
10	2131700638	xxx	Station worked OK	6/19/2013 7:08		A00586630G	3.2	3.7
11	11703G0970	xxx	Station worked OK	6/19/2013 11:17	S12061361
12	5	A0650923C	2.9	55	+292.000mm	+ 1000N	+312.001mm	+ 34000N
13	5
14	11703G0971	xxx	Station worked OK	6/19/2013 11:17	S12061361
15	5	A0650863C	2.95	45	+292.000mm	+ 1000N	+312.001mm	+ 34000N
16	5
17	11703G0972	xxx	Station worked OK	6/19/2013 11:18	S12061361
18	5	A0650853C	2.95	24	+292.000mm	+ 1000N	+312.001mm	+ 34000N
19	5
20
raw

After the macro:

Excel 2007
	A	B	C	D	N	O	P	Q
1	Unit Number	Location	Operation Type	Timestamp	Housing pipe serial number (Barcode)	Housing Set (serial number)	Output Shim Size L.H. Calculated [mm]	Output Shim Size R.H. Calculated [mm]
2	1131700628	xxx	a	6/19/2013 7:01	S12061353	A0773113-	3	60
3	1131700629	xxx	a	6/19/2013 7:02	S12061353	A0773143-	3	54
4	1131700630	xxx	a	6/19/2013 7:03	S12061353	A0773153-	3	73
5	2131700636	xxx	Station worked OK	6/19/2013 7:07		A00586430G	3.25	3.65
6	2131700637	xxx	Station worked OK	6/19/2013 7:07		A00586530G	3.25	3.6
7	2131700638	xxx	Station worked OK	6/19/2013 7:08		A00586630G	3.2	3.7
8	11703G0970	xxx	Station worked OK	6/19/2013 11:17	S12061361	A0650923C	2.9	55
9	11703G0971	xxx	Station worked OK	6/19/2013 11:17	S12061361	A0650863C	2.95	45
10	11703G0972	xxx	Station worked OK	6/19/2013 11:18	S12061361	A0650853C	2.95	24
11
12
13
14
15
16
17
18
19
20
raw

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).

Option Explicit
Sub ReorgData()
' hiker95, 06/21/2013
' http://www.mrexcel.com/forum/excel-questions/709737-if-visual-basic-applications-help.html
Dim r As Long, lr As Long, lc As Long, rng As Range
Application.ScreenUpdating = False
With Sheets("raw")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 2 To lr Step 1
    If .Cells(r, 3) >= 1 And .Cells(r, 3) < 4 Then
      lc = .Cells(r, .Columns.Count).End(xlToLeft).Column
      Set rng = .Range(.Cells(r, 2), .Cells(r, lc))
      rng.Copy Destination:=.Range("O" & r - 1)
      rng.ClearContents
    End If
  Next r
  On Error Resume Next
  .Range("B2:B" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

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

Then run the ReorgData macro.

 

[heman334]

WOW! this one worked awesome! Thank you so much for your help!!

 

[Cric1]

Put this formula in E1 =IF(MOD(ROW(),2)=1,B2,"") then copy E1 to F1 and G1. Copy (E1:G1) until the end of your data set. Select column E:G copy paste special values, sort your data set (A:G) and clear blank cells.