Fill and Sort

[kenpcli]

How do I get it to keep filling in the location number? It breaks after it fills the first site.

47	Totals For MEDICARE RR	$37,253.00	-$15,900.45	-$20,182.52	$0.00	$1,170.03
47	Totals For MOLINA	$0.00	$0.00	$0.00	$0.00	$0.00
47	Totals For MULTIPLAN	$9,156.00	-$4,661.86	-$1,026.14	$0.00	$3,468.00
47	Totals For SELF PAY	$80,687.75	-$38,452.48	-$37,242.02	$149.40	$5,142.65
47	Totals For TRICARE	$39,590.00	-$18,544.17	-$12,423.73	$921.20	$9,543.30
47	Totals For UNITED HEALTHCARE	$237,266.00	-$153,616.60	-$65,164.26	$1,515.56	$20,000.70
47	Totals For VETERANS ADMIN	$23,748.00	-$10,461.24	-$10,419.76	$0.00	$2,867.00
Totals For Albuquerque		$3,661,122.75	-$1,683,474.79	-$1,780,094.21	$16,942.84	$214,496.59
Bellevue
#N/A	Totals For AETNA	$504,981.00	-$312,837.07	-$173,143.99	$8,490.26	$27,490.20
#N/A	Totals For CIGNA	$201,832.00	-$137,141.51	-$43,931.99	$546.69	$21,305.19
#N/A	Totals For COMMERCIAL	$314,544.00	-$221,865.05	-$27,915.65	$0.00	$64,763.30
#N/A	Totals For COMMERCIAL FOUNDATIONS	$11,292.00	-$3,000.00	$0.00	$0.00	$8,292.00

<colgroup><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

Sub FillDownLookup()


Dim Ar As Areas
Dim Rng As Range
Dim ValU As Long

With Sheets("Analysis")
Set Ar = .Range("A6:A" & .Range("C" & Rows.Count).End(xlUp).row).SpecialCells(xlBlanks).Areas
For Each Rng In Ar
Rng.Value = Evaluate("VLookup(" & Rng.Offset(-1).Resize(1).Address & ",'LEGEND SITE'!A1:B20, 2, False)")
Next Rng
.Columns(1).Insert
With Columns(2)
.SpecialCells(xlConstants, xlTextValues).EntireRow.Delete
End With
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C6", .Range("C" & Rows.Count).End(xlUp)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B6:H" & Range("B" & Rows.Count).End(xlUp).row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub

 

[Joe4]

I think we need a more detailed description of what we are looking at there, and what exactly the issue is.
Can you explain, in plain English, exactly how this is supposed to work?

 

[kenpcli]

I think we need a more detailed description of what we are looking at there, and what exactly the issue is.
Can you explain, in plain English, exactly how this is supposed to work?

It looks at the city name above it then looks at the spreadsheet marked site legend to get that city number and fill down until it sees the next city name and so forth.

 

[Joe4]

It looks at the city name above

Where? I do not see city at all in the data you posted.

looks at the spreadsheet marked site legend to get that city number and fill down until it sees the next city name and so forth

How is the data on this Legend Site sheet structured? Maybe post sample of that too.

Remember, while this issue id very familiar to you, it is note for us. All that we have to go on is what you have posted here. The more detail you give, the better the chance of you receiving an answer.

 

[kenpcli]

Where? I do not see city at all in the data you posted.


How is the data on this Legend Site sheet structured? Maybe post sample of that too.

Remember, while this issue id very familiar to you, it is note for us. All that we have to go on is what you have posted here. The more detail you give, the better the chance of you receiving an answer.

here is the legend

Albuquerque	60
Bellevue	30
Bellingham	35
Boise	40
Chehalis	10
Great Falls	47
Kennewick	20
Lewiston	42
Olympia	16
Portland	18
Silverdale	22
Spokane	29
Tacoma	12
Tualatin	19
Vancouver	14
Yakima	25

<tbody>
</tbody><colgroup><col><col></colgroup>

 

[Joe4]

OK. Thanks.
Try this:

Sub FillDownLookup()

    Dim Ar As Areas
    Dim cell As Range
    Dim ValU As Long
    Dim lRow As Long
    Dim match As Range
    
'   Find last row in column C with data
    lRow = Cells(Rows.Count, "C").End(xlUp).Row
    
    Application.ScreenUpdating = False

    With Sheets("Analysis")
        For Each cell In Range("A6:A" & lRow)
            If cell.Value = "" Then
                cell.Value = Evaluate("VLookup(" & match.Address & ",'LEGEND SITE'!A1:B20, 2, False)")
            Else
                Set match = cell
            End If
        Next cell
        
        .Columns(1).Insert
        
        With Columns(2)
            .SpecialCells(xlConstants, xlTextValues).EntireRow.Delete
        End With
        
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("C6", .Range("C" & Rows.Count).End(xlUp)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("B6:H" & Range("B" & Rows.Count).End(xlUp).Row)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    Application.ScreenUpdating = True

End Sub

 

[kenpcli]

OK. Thanks.
Try this:

Sub FillDownLookup()

    Dim Ar As Areas
    Dim cell As Range
    Dim ValU As Long
    Dim lRow As Long
    Dim match As Range
    
'   Find last row in column C with data
    lRow = Cells(Rows.Count, "C").End(xlUp).Row
    
    Application.ScreenUpdating = False

    With Sheets("Analysis")
        For Each cell In Range("A6:A" & lRow)
            If cell.Value = "" Then
                cell.Value = Evaluate("VLookup(" & match.Address & ",'LEGEND SITE'!A1:B20, 2, False)")
            Else
                Set match = cell
            End If
        Next cell
        
        .Columns(1).Insert
        
        With Columns(2)
            .SpecialCells(xlConstants, xlTextValues).EntireRow.Delete
        End With
        
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("C6", .Range("C" & Rows.Count).End(xlUp)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("B6:H" & Range("B" & Rows.Count).End(xlUp).Row)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    Application.ScreenUpdating = True

End Sub

It errors out on this line:
Dim Ar As Areas
Dim cell As Range
Dim ValU As Long
Dim lRow As Long
Dim match As Range

' Find last row in column C with data
lRow = Cells(Rows.Count, "C").End(xlUp).row

Application.ScreenUpdating = False
With Sheets("Analysis")
For Each cell In Range("A6:A" & lRow)
If cell.Value = "" Then
cell.Value = Evaluate("VLookup(" & match.Address & ",'LEGEND SITE'!A1:B20, 2, False)")
Else
Set match = cell
End If
Next cell

.Columns(1).Insert

With Columns(2)
.SpecialCells(xlConstants, xlTextValues).EntireRow.Delete
End With

.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C6", .Range("C" & Rows.Count).End(xlUp)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B6:H" & Range("B" & Rows.Count).End(xlUp).row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Application.ScreenUpdating = True

 

[Joe4]

I just copied it out of your original code. It is not part of the VLOOKUP autofill that I modified.
However, I was able to run the complete code and it worked without issues.

What kind of error message are you getting?
Do you have any hidden, protected, or merged cells?

 

[Fluff]

Should probably be

With[COLOR=#ff0000] .[/COLOR]Columns(2)
   .SpecialCells(xlConstants, xlTextValues).EntireRow.Delete
End With

note the . in front of columns

 

[Joe4]

note the . in front of columns

Good catch. Interestingly, that was the way it was in the original code, and it works just fine for me without it.
Makes me wonder if something else may be going on, like the range issues I mentioned.