Macro to tidy data

D

dapouch

I work with reports coming out of a telephony system. Frustratingly the data
needs to be cleaned after it's imported into excel. The data from first two
columns appears in the row above the next 14 columns.

I have no VBA knowledge. But using the macro recorder I've a long winded
macro that covers the initial 100 rows but I need help developing it to cope
with a 1000+ rows.

Basically - I start by inserting two new columns at the start of my sheet
(new A and B). Then I select cells C2:D2 and move them to A3:B3. I then do
likewise for C4:D4 and move to A5:B5 etc. Once I get to the end I delete all
rows with blanks (every other row) but this may change.

I've searched the forums and can see code for removing blank rows, so should
be ok with that. the help would be a macro for selecting the cells and
moving down a row.

My original macro is below.

Thanks for your help.



ub CallAttempts()
'
' CallAttempts Macro
' Macro recorded 19/08/2009 by damian.poucher
'
' Keyboard Shortcut: Ctrl+a
'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("C2:D2").Select
Range("D2").Activate
Selection.Cut Destination:=Range("A3:B3")
Range("C4:D4").Select
Range("D4").Activate
Selection.Cut Destination:=Range("A5:B5")
Range("C6:D6").Select
Range("D6").Activate
Selection.Cut Destination:=Range("A7:B7")
Range("C8:D8").Select
Range("D8").Activate
Selection.Cut Destination:=Range("A9:B9")
Range("C10:D10").Select
Range("D10").Activate
Selection.Cut Destination:=Range("A11:B11")
Range("C12:D12").Select
Range("D12").Activate
Selection.Cut Destination:=Range("A13:B13")
Range("C14:D14").Select
Range("D14").Activate
Selection.Cut Destination:=Range("A15:B15")
Range("C16:D16").Select
Range("D16").Activate
Selection.Cut Destination:=Range("A17:B17")
Range("A17:B17").Select
ActiveWindow.SmallScroll Down:=15
Range("C18:D18").Select
Range("D18").Activate
Selection.Cut Destination:=Range("A19:B19")
Range("C20:D20").Select
Range("D20").Activate
Selection.Cut Destination:=Range("A21:B21")
Range("C22:D22").Select
Range("D22").Activate
Selection.Cut Destination:=Range("A23:B23")
Range("C24:D24").Select
Range("D24").Activate
Selection.Cut Destination:=Range("A25:B25")
Range("C26:D26").Select
Range("D26").Activate
Selection.Cut Destination:=Range("A27:B27")
Range("C28:D28").Select
Range("D28").Activate
Selection.Cut Destination:=Range("A29:B29")
Range("A29:B29").Select
ActiveWindow.SmallScroll Down:=6
Range("C30:D30").Select
Range("D30").Activate
Selection.Cut Destination:=Range("A31:B31")
Range("C32:D32").Select
Range("D32").Activate
Selection.Cut Destination:=Range("A33:B33")
Range("C34:D34").Select
Range("D34").Activate
Selection.Cut Destination:=Range("A35:B35")
Range("C36:D36").Select
Range("D36").Activate
Selection.Cut Destination:=Range("A37:B37")
Range("C38:D38").Select
Range("D38").Activate
Selection.Cut Destination:=Range("A39:B39")
Range("C40:D40").Select
Range("D40").Activate
Selection.Cut Destination:=Range("A41:B41")
Range("C42:D42").Select
Range("D42").Activate
Selection.Cut Destination:=Range("A43:B43")
Range("C44:D44").Select
Range("D44").Activate
Selection.Cut Destination:=Range("A45:B45")
Range("A45:B45").Select
ActiveWindow.SmallScroll Down:=6
Range("C46:D46").Select
Range("D46").Activate
Selection.Cut Destination:=Range("A47:B47")
Range("C48:D48").Select
Range("D48").Activate
Selection.Cut Destination:=Range("A49:B49")
Range("C50:D50").Select
Range("D50").Activate
Selection.Cut Destination:=Range("A51:B51")
Range("C52:D52").Select
Range("D52").Activate
Selection.Cut Destination:=Range("A53:B53")
Range("A53:B53").Select
ActiveWindow.SmallScroll Down:=12
Range("C54:D54").Select
Range("D54").Activate
Selection.Cut Destination:=Range("A55:B55")
Range("C56:D56").Select
Range("D56").Activate
Selection.Cut Destination:=Range("A57:B57")
Range("C58:D58").Select
Range("D58").Activate
Selection.Cut Destination:=Range("A59:B59")
Range("C60:D60").Select
Range("D60").Activate
Selection.Cut Destination:=Range("A61:B61")
Range("C62:D62").Select
Range("D62").Activate
Selection.Cut Destination:=Range("A63:B63")
Range("C64:D64").Select
Range("D64").Activate
Selection.Cut Destination:=Range("A65:B65")
Range("C66:D66").Select
Range("D66").Activate
Selection.Cut Destination:=Range("A67:B67")
Range("A67:B67").Select
ActiveWindow.SmallScroll Down:=18
Range("C68:D68").Select
Range("D68").Activate
Selection.Cut Destination:=Range("A69:B69")
Range("C70:D70").Select
Range("D70").Activate
Selection.Cut Destination:=Range("A71:B71")
Range("C72:D72").Select
Range("D72").Activate
Selection.Cut Destination:=Range("A73:B73")
Range("C74:D74").Select
Range("D74").Activate
Selection.Cut Destination:=Range("A75:B75")
Range("C76:D76").Select
Range("D76").Activate
Selection.Cut Destination:=Range("A77:B77")
Range("C78:D78").Select
Range("D78").Activate
Selection.Cut Destination:=Range("A79:B79")
Range("A79:B79").Select
ActiveWindow.SmallScroll Down:=9
Range("C80:D80").Select
Range("D80").Activate
Selection.Cut Destination:=Range("A81:B81")
Range("C82:D82").Select
Range("D82").Activate
Selection.Cut Destination:=Range("A83:B83")
Range("C84:D84").Select
Range("D84").Activate
Selection.Cut Destination:=Range("A85:B85")
Range("C86:D86").Select
Range("D86").Activate
Selection.Cut Destination:=Range("A87:B87")
Range("C88:D88").Select
Range("D88").Activate
Selection.Cut Destination:=Range("A89:B89")
Range("A89:B89").Select
ActiveWindow.SmallScroll Down:=9
Range("C90:D90").Select
Range("D90").Activate
Selection.Cut Destination:=Range("A91:B91")
Range("C92:D92").Select
Range("D92").Activate
Selection.Cut Destination:=Range("A93:B93")
Range("C94:D94").Select
Range("D94").Activate
Selection.Cut Destination:=Range("A95:B95")
Range("C96:D96").Select
Range("D96").Activate
Selection.Cut Destination:=Range("A97:B97")
Range("C98:D98").Select
Range("D98").Activate
Selection.Cut Destination:=Range("A99:B99")
Range("A99:B99").Select
ActiveWindow.SmallScroll Down:=-120
Range( _

"2:2,4:4,6:6,8:8,10:10,12:12,14:14,16:16,18:18,20:20,22:22,24:24,26:26,28:28,30:30,32:32,34:34,36:36,38:38,40:40,42:42,44:44,46:46" _
).Select
Range("A46").Activate
ActiveWindow.SmallScroll Down:=36
Union(Range( _

"66:66,68:68,70:70,72:72,74:74,76:76,78:78,2:2,4:4,6:6,8:8,10:10,12:12,14:14,16:16,18:18,20:20,22:22,24:24,26:26,28:28,30:30,32:32,34:34,36:36,38:38,40:40,42:42,44:44,46:46,48:48,50:50" _
), Range("52:52,54:54,56:56,58:58,60:60,62:62,64:64")).Select
Range("A78").Activate
ActiveWindow.SmallScroll Down:=15
Union(Range( _

"66:66,68:68,70:70,72:72,74:74,76:76,78:78,80:80,82:82,84:84,86:86,88:88,2:2,4:4,6:6,8:8,10:10,12:12,14:14,16:16,18:18,20:20,22:22,24:24,26:26,28:28,30:30,32:32,34:34,36:36,38:38,40:40" _
), Range( _

"42:42,44:44,46:46,48:48,50:50,52:52,54:54,56:56,58:58,60:60,62:62,64:64")). _
Select
Range("A88").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-54
ActiveWindow.SmallScroll Down:=-63
Range("B2:B50").Select
ActiveWindow.SmallScroll Down:=-39
Selection.Cut Destination:=Range("R2:R50")
Range("A2:A50").Select
Selection.Cut Destination:=Range("B2:B50")
Range("B2:B50").Select
ActiveWindow.SmallScroll Down:=-54
Range("B2:R50").Select
ActiveWindow.SmallScroll Down:=-63
Selection.Cut Destination:=Range("C2:S50")
Range("C2:S50").Select
Columns("C:C").ColumnWidth = 14.86
Cells.Select
Cells.EntireRow.AutoFit
Range("C2").Select
Columns("C:C").ColumnWidth = 16.29
Cells.Select
Cells.EntireRow.AutoFit
Range("C4").Select
Columns("C:C").ColumnWidth = 17.86
Cells.Select
Cells.EntireRow.AutoFit
Range("C6").Select
End Sub
 
P

PhilosophersSage

Have you tried using the ActiveCell function? This macro will insert two rows
to right "new A & B" then move data from cells C2:D2 to A3:B3 and the like.

Sub TESTMAC()
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 2).Range("A1:B1").Select
Selection.Cut Destination:=ActiveCell.Offset(1, -2).Range("A1:B1")
ActiveCell.Offset(1, 0).Range("A1:B1").Select
Selection.Cut Destination:=ActiveCell.Offset(1, -2).Range("A1:B1")
ActiveCell.Offset(1, -2).Range("A1:B1").Select
End Sub
 
A

Atishoo

I use the folowing sub posted bydon when deleting blank rows.

Sub delblankrows()
lr = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
On Error Resume Next
For i = lr To 2 Step -1
If Rows(i).Find("*") Is Nothing Then Rows(i).Delete
Next i
End Sub
 
D

dapouch

PhilosophersSage,

Thanks for replying to my post. I've never tried Active Cell function as I
did not know it existed...
I've tried using the code below but it only works on the first row of data.
How do I modify the code to work on cells A1:B1 through to A2000:B2000 etc,
without actually repeating the lines of code 2000 times?

Thanks
 
D

dapouch

Sorry to bump this back up but can anyone offer advice please?

I'm still stuck and unable to proceed...

Thanks
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Create new workbook when macro is run 2
Macro Saving 1
Macro working on my pc but no one else's 8
Macro to fill to next field with data 4
Grouping Rows 1
Problem with macro for importing data to template 3

Top