Automate cut paste

[briank]

Hello. I have some VBA experience with Access but a total newbie when it
comes to Excel. I have inherited a series of spreadsheets that need to be in
a totally different format. Manually moving around the data is not the best
approach.

I would like to cut the entire row if the term "Range" is found in Col H and
replace this data in Col A - Col D in the following rows below until the term
"Range" is found again. Then the process would start all over again until
the end of the spreadsheet (which changes from file to file. My example
below is an attempt to better illustrate my thoughts. Any help in this code
or to point me in the right direction would be appreciated.

Existing Example
Col A Col B Col C Col D Col E Col F Col G Col H
1 Jan07 Smith Amt Range
2 Label Field Amt Amt
3 Label Field Amt Amt
4 Mar07 Jones Amt Range
5 Label Field Amt Amt
6 Label Field Amt Amt
7 Jun07 Mason Amt Range

Desired Result
Col A Col B Col C Col D Col E Col F Col G Col H
1 <delete row> Jan07 Smith Amt Range
2 Jan07 Smith Amt Range Label Field Amt Amt
3 Jan07 Smith Amt Range Label Field Amt Amt
4 <delete row> Mar07 Jones Amt Range
5 Mar07 Jones Amt Range Label Field Amt Amt
6 Mar07 Jones Amt Range Label Field Amt Amt
7 <delete row> Jun07 Mason Amt Range
<and so on and so on>

 

[meh2030]

Hello. I have some VBA experience with Access but a total newbie when it
comes to Excel. I have inherited a series of spreadsheets that need to be in
a totally different format. Manually moving around the data is not the best
approach.

I would like to cut the entire row if the term "Range" is found in Col H and
replace this data in Col A - Col D in the following rows below until the term
"Range" is found again. Then the process would start all over again until
the end of the spreadsheet (which changes from file to file. My example
below is an attempt to better illustrate my thoughts. Any help in this code
or to point me in the right direction would be appreciated.

Existing Example
Col A Col B Col C Col D Col E Col F Col G Col H
1 Jan07 Smith Amt Range
2 Label Field Amt Amt
3 Label Field Amt Amt
4 Mar07 Jones Amt Range
5 Label Field Amt Amt
6 Label Field Amt Amt
7 Jun07 Mason Amt Range

Desired Result
Col A Col B Col C Col D Col E Col F Col G Col H
1 <delete row> Jan07 Smith Amt Range
2 Jan07 Smith Amt Range Label Field Amt Amt
3 Jan07 Smith Amt Range Label Field Amt Amt
4 <delete row> Mar07 Jones Amt Range
5 Mar07 Jones Amt Range Label Field Amt Amt
6 Mar07 Jones Amt Range Label Field Amt Amt
7 <delete row> Jun07 Mason Amt Range
<and so on and so on>

Here is some code that should get you started. You will need to test
it and make sure that it fits what you want. Keep in mind that you
may need to add some syntax to handle whatever occurs with the last/
last few lines of data.

I hope this helps.

Matt


Sub moveData()

Dim counter As Integer
Dim a As Integer
Dim testVal As String
Dim delRng As Range

'copy data over
counter = Range("h1").CurrentRegion.Rows.Count
For a = 1 To counter
testVal = Range("h" & a).Value
If testVal = "Range" Then
Range("e" & a, "h" & a).Copy Destination:=Range("a" & a + 1)
End If
Next

'delete rows with "Range" in Col H
counter = Range("h1").CurrentRegion.Rows.Count
For a = counter To 1 Step -1
testVal = Range("h" & a).Value

Set delRng = Range("h" & a)

If testVal = "Range" Then
'Range("h" & a).EntireRow.Delete
delRng.EntireRow.Delete
End If
Next

'fill data down in Col A
counter = Range("h1").CurrentRegion.Rows.Count
For a = 1 To counter
If Range("a" & a).Value = "" Then
'with Range... = "" you may need to look into
'IsEmpty or Range...Text = ""
Range("a" & a, "d" & a).FillDown
End If
Next

End Sub

 

[Joel]

Sub combinerows()

'First Copy, then delete
RowCount = 1
Do While Not IsEmpty(Cells(RowCount, "E"))

If Cells(RowCount, "H") = "Range" Then
CopyRow = RowCount
Else
Range("E" & CopyRow & ":H" & CopyRow).Copy _
Destination:=Range("A" & RowCount)
End If
RowCount = RowCount + 1
Loop

'Now Delete
RowCount = 1
Do While Not IsEmpty(Cells(RowCount, "E"))

If Cells(RowCount, "H") = "Range" Then
Cells(RowCount, "A").EntireRow.Delete
Else
RowCount = RowCount + 1
End If
Loop

End Sub

 

[briank]

The code works perfectly. Thank you for your assitance.
briank