Fill and Sort

K

kenpcli

Board Regular
Joined
Oct 24, 2017
Messages
129
How do I get it to keep filling in the location number? It breaks after it fills the first site.


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


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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
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?
 
Upvote 0
Joe4 said:
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?
Click to expand...

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.
 
Upvote 0
It looks at the city name above
Click to expand...
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
Click to expand...
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.
 
Upvote 0
Joe4 said:
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.
Click to expand...

here is the legend
[TABLE="width: 255"]
<tbody>[TR]
[TD]Albuquerque[/TD]
[TD="align: right"]60[/TD]
[/TR]
[TR]
[TD]Bellevue[/TD]
[TD="align: right"]30[/TD]
[/TR]
[TR]
[TD]Bellingham[/TD]
[TD="align: right"]35[/TD]
[/TR]
[TR]
[TD]Boise[/TD]
[TD="align: right"]40[/TD]
[/TR]
[TR]
[TD]Chehalis[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Great Falls[/TD]
[TD="align: right"]47[/TD]
[/TR]
[TR]
[TD]Kennewick[/TD]
[TD="align: right"]20[/TD]
[/TR]
[TR]
[TD]Lewiston[/TD]
[TD="align: right"]42[/TD]
[/TR]
[TR]
[TD]Olympia[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD]Portland[/TD]
[TD="align: right"]18[/TD]
[/TR]
[TR]
[TD]Silverdale[/TD]
[TD="align: right"]22[/TD]
[/TR]
[TR]
[TD]Spokane[/TD]
[TD="align: right"]29[/TD]
[/TR]
[TR]
[TD]Tacoma[/TD]
[TD="align: right"]12[/TD]
[/TR]
[TR]
[TD]Tualatin[/TD]
[TD="align: right"]19[/TD]
[/TR]
[TR]
[TD]Vancouver[/TD]
[TD="align: right"]14[/TD]
[/TR]
[TR]
[TD]Yakima[/TD]
[TD="align: right"]25[/TD]
[/TR]
</tbody><colgroup><col><col></colgroup>[/TABLE]
 
Upvote 0
OK. Thanks.
Try this:
Code: 
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
 
Upvote 0
Joe4 said:
OK. Thanks.
Try this:
Code: 
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
Click to expand...

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
 
Upvote 0
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?
 
Upvote 0
Should probably be
Code: 
With[COLOR=#ff0000] .[/COLOR]Columns(2)
   .SpecialCells(xlConstants, xlTextValues).EntireRow.Delete
End With
note the . in front of columns
 
Upvote 0
note the . in front of columns
Click to expand...
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Copy sheet and add Location number
2 3 4
Replies
37
Views
3K
kenpcli
K

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top