How do I get it to keep filling in the location number? It breaks after it fills the first site.
<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
| 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
