PDA

View Full Version : Fill Down Data



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

SamT
10-23-2014, 08:49 AM
I can see at least three flaws, but let's just go with the internal logic is wrong.


Option Explicit


Sub FilDown()
Dim ACel As Range 'Cell in Column A
Dim CCel As Range 'Cell in Column C
Dim CCCount As Long 'Nmemonic for CCel Count

With Sheet1
Set CCel = .Cells(Rows.Count, 3).End(xlUp)
If CCel.Address = "C1" Then GoTo MBDone

CCCount = 1

'Find bottom Client Amount
Do
Set CCel = CCel.Offset(0, -1)
If CCel.Value <> "" Then CCCount = CCCount + 1
If CCel.Address = "C1" Then GoTo MBDone

Loop Until CCCount = 3

'Find Bottom Client Date
Set ACel = .Cells(Rows.Count, 1).End(xlUp)

Do
ACel.Resize(1, 2).Cut (CCel.Offset(-2, 0))
Do
Set CCel = CCel.Offset(-1, 0)GoTo MBDone

Loop Until CCel.Value <> ""

Do
Set ACel = ACel.Offset(-1, 0)
Loop Until ACel.Value <> ""
Loop
End With

MBDone:
MsgBox "Done!"

End Sub

Ringhal
10-24-2014, 01:57 AM
Hi SamT

There are errors when I run your code. The one I fixed by changing:

Set CCel = CCel.Offset(-1, 0)Goto MBDone
to:

Set CCel = CCel.Offset(-1, 0)
Goto MBDone
The next error was 'Run-time error '1004' and didn't point to any specific line. It appears, from running the code step by step in break mode, THAT the error is somewhere here:

'Find bottom Client Amount
Do
Set CCel = CCel.Offset(0, -1)
If CCel.Value <> "" Then CCCount = CCCount + 1
If CCel.Address = "C1" Then GoTo MBDone
Loop Until CCCount = 3

SamT
10-24-2014, 07:58 AM
Remind me what a 'Run-time error '1004' is.

Which line of the loop was yellow?

Ringhal
10-24-2014, 08:36 AM
Application-defined or Object-defined error
There is no yellow line. The options on the error box are only OK and Help and no Debug

SamT
10-24-2014, 09:34 AM
I see an obvious typo in the code I made

Do
Set CCel = CCel.Offset(0, -1)

Should be

Do
Set CCel = CCel.Offset(-1, 0)

But I think that would only raise a 1004 error if Column C was completely empty and I don't see how the code could have gotten past the previous GoTo.