Macro to tidy data

dapouch · Sep 29, 2009

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

2 and move them to A3:B3. I then do
likewise for C4

4 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

2").Select
Range("D2").Activate
Selection.Cut Destination:=Range("A3:B3")
Range("C4

4").Select
Range("D4").Activate
Selection.Cut Destination:=Range("A5:B5")
Range("C6

6").Select
Range("D6").Activate
Selection.Cut Destination:=Range("A7:B7")
Range("C8

8").Select
Range("D8").Activate
Selection.Cut Destination:=Range("A9:B9")
Range("C10

10").Select
Range("D10").Activate
Selection.Cut Destination:=Range("A11:B11")
Range("C12

12").Select
Range("D12").Activate
Selection.Cut Destination:=Range("A13:B13")
Range("C14

14").Select
Range("D14").Activate
Selection.Cut Destination:=Range("A15:B15")
Range("C16

16").Select
Range("D16").Activate
Selection.Cut Destination:=Range("A17:B17")
Range("A17:B17").Select
ActiveWindow.SmallScroll Down:=15
Range("C18

18").Select
Range("D18").Activate
Selection.Cut Destination:=Range("A19:B19")
Range("C20

20").Select
Range("D20").Activate
Selection.Cut Destination:=Range("A21:B21")
Range("C22

22").Select
Range("D22").Activate
Selection.Cut Destination:=Range("A23:B23")
Range("C24

24").Select
Range("D24").Activate
Selection.Cut Destination:=Range("A25:B25")
Range("C26

26").Select
Range("D26").Activate
Selection.Cut Destination:=Range("A27:B27")
Range("C28

28").Select
Range("D28").Activate
Selection.Cut Destination:=Range("A29:B29")
Range("A29:B29").Select
ActiveWindow.SmallScroll Down:=6
Range("C30

30").Select
Range("D30").Activate
Selection.Cut Destination:=Range("A31:B31")
Range("C32

32").Select
Range("D32").Activate
Selection.Cut Destination:=Range("A33:B33")
Range("C34

34").Select
Range("D34").Activate
Selection.Cut Destination:=Range("A35:B35")
Range("C36

36").Select
Range("D36").Activate
Selection.Cut Destination:=Range("A37:B37")
Range("C38

38").Select
Range("D38").Activate
Selection.Cut Destination:=Range("A39:B39")
Range("C40

40").Select
Range("D40").Activate
Selection.Cut Destination:=Range("A41:B41")
Range("C42

42").Select
Range("D42").Activate
Selection.Cut Destination:=Range("A43:B43")
Range("C44

44").Select
Range("D44").Activate
Selection.Cut Destination:=Range("A45:B45")
Range("A45:B45").Select
ActiveWindow.SmallScroll Down:=6
Range("C46

46").Select
Range("D46").Activate
Selection.Cut Destination:=Range("A47:B47")
Range("C48

48").Select
Range("D48").Activate
Selection.Cut Destination:=Range("A49:B49")
Range("C50

50").Select
Range("D50").Activate
Selection.Cut Destination:=Range("A51:B51")
Range("C52

52").Select
Range("D52").Activate
Selection.Cut Destination:=Range("A53:B53")
Range("A53:B53").Select
ActiveWindow.SmallScroll Down:=12
Range("C54

54").Select
Range("D54").Activate
Selection.Cut Destination:=Range("A55:B55")
Range("C56

56").Select
Range("D56").Activate
Selection.Cut Destination:=Range("A57:B57")
Range("C58

58").Select
Range("D58").Activate
Selection.Cut Destination:=Range("A59:B59")
Range("C60

60").Select
Range("D60").Activate
Selection.Cut Destination:=Range("A61:B61")
Range("C62

62").Select
Range("D62").Activate
Selection.Cut Destination:=Range("A63:B63")
Range("C64

64").Select
Range("D64").Activate
Selection.Cut Destination:=Range("A65:B65")
Range("C66

66").Select
Range("D66").Activate
Selection.Cut Destination:=Range("A67:B67")
Range("A67:B67").Select
ActiveWindow.SmallScroll Down:=18
Range("C68

68").Select
Range("D68").Activate
Selection.Cut Destination:=Range("A69:B69")
Range("C70

70").Select
Range("D70").Activate
Selection.Cut Destination:=Range("A71:B71")
Range("C72

72").Select
Range("D72").Activate
Selection.Cut Destination:=Range("A73:B73")
Range("C74

74").Select
Range("D74").Activate
Selection.Cut Destination:=Range("A75:B75")
Range("C76

76").Select
Range("D76").Activate
Selection.Cut Destination:=Range("A77:B77")
Range("C78

78").Select
Range("D78").Activate
Selection.Cut Destination:=Range("A79:B79")
Range("A79:B79").Select
ActiveWindow.SmallScroll Down:=9
Range("C80

80").Select
Range("D80").Activate
Selection.Cut Destination:=Range("A81:B81")
Range("C82

82").Select
Range("D82").Activate
Selection.Cut Destination:=Range("A83:B83")
Range("C84

84").Select
Range("D84").Activate
Selection.Cut Destination:=Range("A85:B85")
Range("C86

86").Select
Range("D86").Activate
Selection.Cut Destination:=Range("A87:B87")
Range("C88

88").Select
Range("D88").Activate
Selection.Cut Destination:=Range("A89:B89")
Range("A89:B89").Select
ActiveWindow.SmallScroll Down:=9
Range("C90

90").Select
Range("D90").Activate
Selection.Cut Destination:=Range("A91:B91")
Range("C92

92").Select
Range("D92").Activate
Selection.Cut Destination:=Range("A93:B93")
Range("C94

94").Select
Range("D94").Activate
Selection.Cut Destination:=Range("A95:B95")
Range("C96

96").Select
Range("D96").Activate
Selection.Cut Destination:=Range("A97:B97")
Range("C98

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

PhilosophersSage · Sep 29, 2009

Have you tried using the ActiveCell function? This macro will insert two rows
to right "new A & B" then move data from cells C2

2 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

Atishoo · Sep 29, 2009

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

dapouch · Oct 2, 2009

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

dapouch · Oct 6, 2009

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

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

Thanks

Macro to tidy data

dapouch

PhilosophersSage

Atishoo

dapouch

dapouch