Fill Down Data

[Ringhal]

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 sample.xlsm:

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]

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]

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]

Remind me what a 'Run-time error '1004' is.

Which line of the loop was yellow?

[Ringhal]

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]

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.