Ringhal
10-23-2014, 06:53 AM
Hi all
I have data that gets copied from a source but isn't formatted correctly and rows are in the incorrect place. Attached is the sample workbook, Sheet1 is the original and Sheet2 is what I need the final to be. The sheet has, what you could call "headings" and below them in the following rows, is the data for each heading. The problem is, I need the heading to be on the same row as the data to make it easier to work with the data. Also, on the same row as the heading is a date, which also needs to be filled down to the below rows. The original heading also needs to be deleted so that it doesn't look out of place
I have come up with some code that partially does what I need, but isn't very efficient nor complete. I am aware of one major flaw with my code, but I couldn't see a way around it. The code is in sheet1 of the book and pasted below 12429:
Sub FilDown()
Dim i As Long
Dim j As Long
Dim cel As Range
Dim Blnk As Long
Dim Rng As Range
With Sheet1
For i = .Cells(.Rows.Count, "B").End(xlUp).Row To 0 Step -1
Set cel = .Range("B1").Offset(i, 0)
Blnk = cel.End(xlDown).Offset(-1, 0).Row
If Not cel = "" Then
Set Rng = .Range("B" & cel.Row & ":B" & Blnk)
cel.AutoFill Destination:=Rng, Type:=xlFillValues
End If
Next i
For j = .Cells(.Rows.Count, "A").End(xlUp).Row To 0 Step -1
Set cel = .Range("A1").Offset(j, 0)
Blnk = cel.End(xlDown).Offset(-1, 0).Row
If Not cel = "" Then
Set Rng = .Range("A" & cel.Row & ":A" & Blnk)
cel.AutoFill Destination:=Rng, Type:=xlFillCopy
End If
Next j
.Range("A1:J" & .Cells(.Rows.Count, "D").End(xlUp).Row).Style = "Normal"
End With
MsgBox "Done!"
End Sub
I have data that gets copied from a source but isn't formatted correctly and rows are in the incorrect place. Attached is the sample workbook, Sheet1 is the original and Sheet2 is what I need the final to be. The sheet has, what you could call "headings" and below them in the following rows, is the data for each heading. The problem is, I need the heading to be on the same row as the data to make it easier to work with the data. Also, on the same row as the heading is a date, which also needs to be filled down to the below rows. The original heading also needs to be deleted so that it doesn't look out of place
I have come up with some code that partially does what I need, but isn't very efficient nor complete. I am aware of one major flaw with my code, but I couldn't see a way around it. The code is in sheet1 of the book and pasted below 12429:
Sub FilDown()
Dim i As Long
Dim j As Long
Dim cel As Range
Dim Blnk As Long
Dim Rng As Range
With Sheet1
For i = .Cells(.Rows.Count, "B").End(xlUp).Row To 0 Step -1
Set cel = .Range("B1").Offset(i, 0)
Blnk = cel.End(xlDown).Offset(-1, 0).Row
If Not cel = "" Then
Set Rng = .Range("B" & cel.Row & ":B" & Blnk)
cel.AutoFill Destination:=Rng, Type:=xlFillValues
End If
Next i
For j = .Cells(.Rows.Count, "A").End(xlUp).Row To 0 Step -1
Set cel = .Range("A1").Offset(j, 0)
Blnk = cel.End(xlDown).Offset(-1, 0).Row
If Not cel = "" Then
Set Rng = .Range("A" & cel.Row & ":A" & Blnk)
cel.AutoFill Destination:=Rng, Type:=xlFillCopy
End If
Next j
.Range("A1:J" & .Cells(.Rows.Count, "D").End(xlUp).Row).Style = "Normal"
End With
MsgBox "Done!"
End Sub