Help with macro or VB to Merge Multiple Columns Of Data Im getting RSI from all the copy and pastin

D

daniel.barrett

I have an application that exports data as below
ABSLIVE AGRDEVBACK AGRDEVWEB
26/06/06 1294 26/06/06 1436 26/06/06 399
26/06/06 1299 26/06/06 1439 26/06/06 399
27/06/06 1318 27/06/06 1452 27/06/06 404



This is a sample of six columns . The text in row 1 is in columns 2,4
& 6
The cells in row 1 in columns 1,3 & 6 are empty

There are varying numbers columns and rows each time the application
exports.
All of the dates are consistent across each row

I need to convert this to a structure that can be converted into an
access database


something like this

ABSLIVE 26/06/06 1294
ABSLIVE 26/06/06 1299
ABSLIVE 27/06/06 1318
AGRDEVBACK 26/06/06 1436

etc etc
Hope someone can help

Thanks

daniel
 
B

Bernie Deitrick

Daniel,

Try this:

Sub NewSub()
Dim lngRow As Long

lngRow = Range("A65536").End(xlUp).Row
Columns("A:A").Insert Shift:=xlToRight
Columns("D:D").Insert Shift:=xlToRight
Columns("G:G").Insert Shift:=xlToRight
Range("A2:A" & lngRow).FormulaR1C1 = "=R1C3"
Range("D2:D" & lngRow).FormulaR1C1 = "=R1C6"
Range("G2:G" & lngRow).FormulaR1C1 = "=R1C9"
With Range("A2").CurrentRegion
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("D2:F" & lngRow).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Range("G2:I" & lngRow).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Range("A1").EntireRow.Delete
Range("A1").Select
End Sub

HTH,
Bernie
MS Excel MVP
 
D

daniel.barrett

Thanks Bernie,
This works great however my spreadsheet has more
than 6 columns and the exact number varies from each export to export.
Any ideas how i would get this to do exactly the same process but for
multiple columns, say until it findsa a blank cell in row 1?

Thanks

Dan
 
B

Bernie Deitrick

Daniel,

Ooops, missed that part. Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub NewSub()
Dim lngRow As Long
Dim i As Integer
Dim ColCnt As Integer
ColCnt = Cells(1, 256).End(xlToLeft).Column
lngRow = Range("A65536").End(xlUp).Row

For i = 1 To ColCnt * 3 / 2 Step 3
Columns(i).Insert Shift:=xlToRight
Range(Cells(2, i), Cells(lngRow, i)).FormulaR1C1 = "=R1C[2]" ' & i * 3
Next i

With Range("A2").CurrentRegion
.Copy
.PasteSpecial Paste:=xlPasteValues
End With

For i = 4 To ColCnt * 3 / 2 Step 3
Range(Cells(2, i), Cells(lngRow, i + 2)).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Next i

Range("A1").EntireRow.Delete
Range("A1").Select
End Sub
 
D

daniel.barrett

Sooo nearly there, but becuase my spreadsheet has so many columns its
causes an error becasuee its trying to shift data off the edge of the
sheet

any ideas?

thanks so much for this btw

Regards


Dan


Bernie said:
Daniel,

Ooops, missed that part. Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub NewSub()
Dim lngRow As Long
Dim i As Integer
Dim ColCnt As Integer
ColCnt = Cells(1, 256).End(xlToLeft).Column
lngRow = Range("A65536").End(xlUp).Row

For i = 1 To ColCnt * 3 / 2 Step 3
Columns(i).Insert Shift:=xlToRight
Range(Cells(2, i), Cells(lngRow, i)).FormulaR1C1 = "=R1C[2]" ' & i * 3
Next i

With Range("A2").CurrentRegion
.Copy
.PasteSpecial Paste:=xlPasteValues
End With

For i = 4 To ColCnt * 3 / 2 Step 3
Range(Cells(2, i), Cells(lngRow, i + 2)).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Next i

Range("A1").EntireRow.Delete
Range("A1").Select
End Sub


Thanks Bernie,
This works great however my spreadsheet has more
than 6 columns and the exact number varies from each export to export.
Any ideas how i would get this to do exactly the same process but for
multiple columns, say until it findsa a blank cell in row 1?

Thanks

Dan
Click to expand...
Click to expand...
 
B

Bernie Deitrick

Daniel,

Sub NewestSub()
Dim lngRow As Long
Dim i As Integer
Dim ColCnt As Integer
ColCnt = Cells(1, 256).End(xlToLeft).Column
lngRow = Range("A65536").End(xlUp).Row

Columns(1).Insert Shift:=xlToRight
With Range(Cells(2, 1), Cells(lngRow, 1))
.FormulaR1C1 = "=R1C[2]"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With

For i = 2 To ColCnt / 2
Columns(4).Insert Shift:=xlToRight
Range(Cells(2, 4), Cells(lngRow, 4)).FormulaR1C1 = "=R1C[2]"
Range(Cells(2, 4), Cells(lngRow, 6)).Copy
Range("A65536").End(xlUp)(2).Select
Selection.PasteSpecial xlPasteValues
Range("D:F").Delete
Next i

Range("A1").EntireRow.Delete
Range("A1").Select
End Sub

HTH,
Bernie
MS Excel MVP



Sooo nearly there, but becuase my spreadsheet has so many columns its
causes an error becasuee its trying to shift data off the edge of the
sheet

any ideas?

thanks so much for this btw

Regards


Dan


Bernie said:
Daniel,

Ooops, missed that part. Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub NewSub()
Dim lngRow As Long
Dim i As Integer
Dim ColCnt As Integer
ColCnt = Cells(1, 256).End(xlToLeft).Column
lngRow = Range("A65536").End(xlUp).Row

For i = 1 To ColCnt * 3 / 2 Step 3
Columns(i).Insert Shift:=xlToRight
Range(Cells(2, i), Cells(lngRow, i)).FormulaR1C1 = "=R1C[2]" ' & i * 3
Next i

With Range("A2").CurrentRegion
.Copy
.PasteSpecial Paste:=xlPasteValues
End With

For i = 4 To ColCnt * 3 / 2 Step 3
Range(Cells(2, i), Cells(lngRow, i + 2)).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Next i

Range("A1").EntireRow.Delete
Range("A1").Select
End Sub


Thanks Bernie,
This works great however my spreadsheet has more
than 6 columns and the exact number varies from each export to export.
Any ideas how i would get this to do exactly the same process but for
multiple columns, say until it findsa a blank cell in row 1?

Thanks

Dan
Bernie Deitrick wrote:
Daniel,

Try this:

Sub NewSub()
Dim lngRow As Long

lngRow = Range("A65536").End(xlUp).Row
Columns("A:A").Insert Shift:=xlToRight
Columns("D:D").Insert Shift:=xlToRight
Columns("G:G").Insert Shift:=xlToRight
Range("A2:A" & lngRow).FormulaR1C1 = "=R1C3"
Range("D2:D" & lngRow).FormulaR1C1 = "=R1C6"
Range("G2:G" & lngRow).FormulaR1C1 = "=R1C9"
With Range("A2").CurrentRegion
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("D2:F" & lngRow).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Range("G2:I" & lngRow).Cut
Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste
Range("A1").EntireRow.Delete
Range("A1").Select
End Sub

HTH,
Bernie
MS Excel MVP


I have an application that exports data as below
ABSLIVE AGRDEVBACK AGRDEVWEB
26/06/06 1294 26/06/06 1436 26/06/06 399
26/06/06 1299 26/06/06 1439 26/06/06 399
27/06/06 1318 27/06/06 1452 27/06/06 404



This is a sample of six columns . The text in row 1 is in columns
2,4
& 6
The cells in row 1 in columns 1,3 & 6 are empty

There are varying numbers columns and rows each time the application
exports.
All of the dates are consistent across each row

I need to convert this to a structure that can be converted into an
access database


something like this

ABSLIVE 26/06/06 1294
ABSLIVE 26/06/06 1299
ABSLIVE 27/06/06 1318
AGRDEVBACK 26/06/06 1436

etc etc
Hope someone can help

Thanks

daniel
Click to expand...
Click to expand...
Click to expand...
 
Top