Copy sheet and add Location number

kenpcli · Nov 3, 2017

I am trying get a macro to look down column A and each change in site name add their location number underneath it.

		Chg Amt	Pay Amt	Adj Amt	Ref Amt	Bal Amt
Albuquerque
60	Totals For AETNA	$51,896.00	-$31,204.59	-$19,152.69	$164.35	$1,703.07
60	Totals For BCBS	$659,678.00	-$320,482.96	-$324,294.18	$7,687.05	$22,587.91
60	Totals For CIGNA	$264.00	-$211.20	-$52.80	$0.00	$0.00
60	Totals For COMMERCIAL	$20,122.00	-$13,354.59	-$4,563.70	$0.00	$2,203.71
60	Totals For DSHS	$8,573.00	-$4,020.36	-$60.64	$0.00	$4,492.00
60	Totals For FCHN	$3,774.00	-$2,868.21	-$905.79	$0.00	$0.00
60	Totals For HUMANA	$309.00	-$167.12	-$141.88	$0.00	$0.00
60	Totals For IPN	$3,923.00	-$2,678.76	-$1,244.24	$0.00	$0.00
60	Totals For MEDICAID COMMERCIAL	$115,651.00	-$41,467.85	-$57,352.41	$498.51	$17,329.25
60	Totals For MEDICARE	$1,928,300.00	-$849,877.14	-$1,015,188.85	$3,064.69	$66,298.70
60	Totals For MEDICARE ADVANTAGE	$440,932.00	-$175,505.21	-$210,678.60	$2,942.08	$57,690.27
60	Totals For MEDICARE RR	$37,253.00	-$15,900.45	-$20,182.52	$0.00	$1,170.03
60	Totals For MOLINA	$0.00	$0.00	$0.00	$0.00	$0.00
60	Totals For MULTIPLAN	$9,156.00	-$4,661.86	-$1,026.14	$0.00	$3,468.00
60	Totals For SELF PAY	$80,687.75	-$38,452.48	-$37,242.02	$149.40	$5,142.65
60	Totals For TRICARE	$39,590.00	-$18,544.17	-$12,423.73	$921.20	$9,543.30
60	Totals For UNITED HEALTHCARE	$237,266.00	-$153,616.60	-$65,164.26	$1,515.56	$20,000.70
60	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
30	Totals For AETNA	$504,981.00	-$312,837.07	-$173,143.99	$8,490.26	$27,490.20
30	Totals For CIGNA	$201,832.00	-$137,141.51	-$43,931.99	$546.69	$21,305.19

kenpcli · Dec 27, 2017

Fluff said:

In that case how about

Code:

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:B1000, 2, False)")
        Next Rng
    End With
    
End Sub

Thank you I will try this and let you know how it works.

kenpcli · Dec 27, 2017

kenpcli said:
Thank you I will try this and let you know how it works.

This is what I get when it runs: The site number is not correct and it stops after the first location.

Albuquerque
47	Totals For AETNA	$51,896.00	-$31,204.59	-$19,152.69	$164.35	$1,703.07
47	Totals For BCBS	$659,678.00	-$320,482.96	-$324,294.18	$7,687.05	$22,587.91
47	Totals For CIGNA	$264.00	-$211.20	-$52.80	$0.00	$0.00
47	Totals For COMMERCIAL	$20,122.00	-$13,354.59	-$4,563.70	$0.00	$2,203.71
47	Totals For DSHS	$8,573.00	-$4,020.36	-$60.64	$0.00	$4,492.00
47	Totals For FCHN	$3,774.00	-$2,868.21	-$905.79	$0.00	$0.00
47	Totals For HUMANA	$309.00	-$167.12	-$141.88	$0.00	$0.00
47	Totals For IPN	$3,923.00	-$2,678.76	-$1,244.24	$0.00	$0.00
47	Totals For MEDICAID COMMERCIAL	$115,651.00	-$41,467.85	-$57,352.41	$498.51	$17,329.25
47	Totals For MEDICARE	$1,928,300.00	-$849,877.14	-$1,015,188.85	$3,064.69	$66,298.70
47	Totals For MEDICARE ADVANTAGE	$440,932.00	-$175,505.21	-$210,678.60	$2,942.08	$57,690.27
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
#N/A	Totals For CONTRACTED COMMERCIAL	$454.00	-$241.25	-$129.29	$0.00	$83.46
#N/A	Totals For COORDINATED CARE	$216,179.00	-$93,977.41	-$111,775.06	$600.01	$11,026.54
#N/A	Totals For DSHS	$70,023.00	-$21,523.32	-$38,280.68	$0.00	$10,219.00
#N/A	Totals For FCHN	$195,657.00	-$139,056.11	-$42,719.61	$1,304.50	$15,185.78
#N/A	Totals For IPN	$55.00	-$20.41	-$34.59	$0.00	$0.00

Fluff · Dec 27, 2017

This is what I get

Excel 2013 32 bit

A

B

1

Site

No

2

Albuquerque

60

3

Bellevue

30

4

Bellingham

35

5

Boise

40

6

Chehalis

10

7

Great Falls

47

8

Kennewick

20

9

Lewiston

42

10

Olympia

16

11

Portland

18

12

Silverdale

22

13

Spokane

29

14

Tacoma

12

15

Tualatin

19

16

Vancouver

14

17

Yakima

25

Legend site

Excel 2013 32 bit

A

B

C

D

E

F

G

1

Pacific Cataract And Laser Institute

2

PCLI CONTRACTUAL YTD BY SITE

3

From 1/1/2017 to 9/30/2017

4

10/16/2017 12:04 PM

5

Chg Amt

Pay Amt

Adj Amt

Ref Amt

Bal Amt

6

Albuquerque

7

60

Totals For AETNA

$51,896.00

-$31,204.59

-$19,152.69

$164.35

$1,703.07

8

60

Totals For BCBS

$659,678.00

-$320,482.96

-$324,294.18

$7,687.05

$22,587.91

25

Totals For Albuquerque

$3,661,122.75

-$1,683,474.79

-$1,780,094.21

$16,942.84

$214,496.59

26

Bellevue

27

30

Totals For AETNA

$504,981.00

-$312,837.07

-$173,143.99

$8,490.26

$27,490.20

28

30

Totals For CIGNA

$201,832.00

-$137,141.51

-$43,931.99

$546.69

$21,305.19

49

30

Totals For UNITED HEALTHCARE

$235,518.00

-$161,307.83

-$60,194.42

$2,498.52

$16,514.27

50

Totals For Bellevue

$10,791,128.00

-$6,031,247.18

-$4,342,203.21

$42,962.36

$460,639.97

51

Spokane

52

29

Totals For AETNA

$51,896.00

-$31,204.59

-$19,152.69

$164.35

$1,703.07

53

29

Totals For BCBS

$659,678.00

-$320,482.96

-$324,294.18

$7,687.05

$22,587.91

69

29

Totals For VETERANS ADMIN

$23,748.00

-$10,461.24

-$10,419.76

$0.00

$2,867.00

70

Totals For Spokane

$3,661,122.75

-$1,683,474.79

-$1,780,094.21

$16,942.84

$214,496.59

71

Great Falls

72

47

Totals For AETNA

$504,981.00

-$312,837.07

-$173,143.99

$8,490.26

$27,490.20

94

47

Totals For UNITED HEALTHCARE

$235,518.00

-$161,307.83

-$60,194.42

$2,498.52

$16,514.27

95

Totals For Great Falls

$10,791,128.00

-$6,031,247.18

-$4,342,203.21

$42,962.36

$460,639.97

Analysis

kenpcli · Dec 27, 2017

Fluff said:
This is what I get
Excel 2013 32 bit

A B
1 Site No
2 Albuquerque 60
3 Bellevue 30
4 Bellingham 35
5 Boise 40
6 Chehalis 10
7 Great Falls 47
8 Kennewick 20
9 Lewiston 42
10 Olympia 16
11 Portland 18
12 Silverdale 22
13 Spokane 29
14 Tacoma 12
15 Tualatin 19
16 Vancouver 14
17 Yakima 25

<colgroup><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Legend site

Excel 2013 32 bit

A B C D E F G
1 Pacific Cataract And Laser Institute
2 PCLI CONTRACTUAL YTD BY SITE
3 From 1/1/2017 to 9/30/2017
4 10/16/2017 12:04 PM
5 Chg Amt Pay Amt Adj Amt Ref Amt Bal Amt
6 Albuquerque
7 60 Totals For AETNA $51,896.00 -$31,204.59 -$19,152.69 $164.35 $1,703.07
8 60 Totals For BCBS $659,678.00 -$320,482.96 -$324,294.18 $7,687.05 $22,587.91
25 Totals For Albuquerque $3,661,122.75 -$1,683,474.79 -$1,780,094.21 $16,942.84 $214,496.59
26 Bellevue
27 30 Totals For AETNA $504,981.00 -$312,837.07 -$173,143.99 $8,490.26 $27,490.20
28 30 Totals For CIGNA $201,832.00 -$137,141.51 -$43,931.99 $546.69 $21,305.19
49 30 Totals For UNITED HEALTHCARE $235,518.00 -$161,307.83 -$60,194.42 $2,498.52 $16,514.27
50 Totals For Bellevue $10,791,128.00 -$6,031,247.18 -$4,342,203.21 $42,962.36 $460,639.97
51 Spokane
52 29 Totals For AETNA $51,896.00 -$31,204.59 -$19,152.69 $164.35 $1,703.07
53 29 Totals For BCBS $659,678.00 -$320,482.96 -$324,294.18 $7,687.05 $22,587.91
69 29 Totals For VETERANS ADMIN $23,748.00 -$10,461.24 -$10,419.76 $0.00 $2,867.00
70 Totals For Spokane $3,661,122.75 -$1,683,474.79 -$1,780,094.21 $16,942.84 $214,496.59
71 Great Falls
72 47 Totals For AETNA $504,981.00 -$312,837.07 -$173,143.99 $8,490.26 $27,490.20
94 47 Totals For UNITED HEALTHCARE $235,518.00 -$161,307.83 -$60,194.42 $2,498.52 $16,514.27
95 Totals For Great Falls $10,791,128.00 -$6,031,247.18 -$4,342,203.21 $42,962.36 $460,639.97

<colgroup><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Analysis

ok if I try it as a stand alone it works, but if I add it to the already existing code, it breaks.

Sub MergeWorkbooks()
Dim FolderName As String
Dim directory As String, fileName As String
Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet
Set wb1 = Workbooks.Add

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder."
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
directory = FolderName & ""
fileName = Dir(directory & "*.xls?")
Do While fileName <> ""
Set wb2 = Workbooks.Open(directory & fileName)
For Each ws In wb2.Sheets
ws.Copy After:=wb1.Sheets(wb1.Sheets.Count)
Next ws
wb2.Close savechanges:=False
fileName = Dir
Loop
'Stopping Application Alerts
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
'Enabling Application alerts once we are done with our task
Application.DisplayAlerts = True
Sheets("Page 1 (3)").Name = "Analysis"
Sheets("Page 1 (4)").Name = "PCLI TB"
Sheets("Page 1 (2)").Name = "Charges Posted After"
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:B1000, 2, False)")
Next Rng
End With
End Sub

Fluff · Dec 27, 2017

Do you have a sheet in that workbook called Legend Site?

kenpcli · Dec 27, 2017

Fluff said:
Do you have a sheet in that workbook called Legend Site?

Yes

Fluff · Dec 27, 2017

There's nothing I can see in your code that would cause a problem.
But as the code I supplied works on its own & because I can't see your files, or sheets there's not much more I can do to help.

kenpcli · Dec 27, 2017

Fluff said:
There's nothing I can see in your code that would cause a problem.
But as the code I supplied works on its own & because I can't see your files, or sheets there's not much more I can do to help.

I understand, thank you. I broke it into two macros and it works fine.

kenpcli · Dec 27, 2017

I think it broke again, now when I run it, it doesn't like

Set Ar = .Range("A6:A" & .Range("C" & rows.Count).End(xlUp).row).SpecialCells(xlBlanks).Areas

any ideas?

Fluff · Dec 28, 2017

Are some of the files .xls & some newer versions such as .xlsx or .xlsm?

Copy sheet and add Location number

kenpcli

Board Regular

kenpcli

Board Regular

Excel Facts

kenpcli

Board Regular

Fluff

MrExcel MVP, Moderator

kenpcli

Board Regular

Fluff

MrExcel MVP, Moderator

kenpcli

Board Regular

Fluff

MrExcel MVP, Moderator

kenpcli

Board Regular

kenpcli

Board Regular

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Copy sheet and add Location number

Board Regular

Board Regular

Excel Facts

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

Board Regular

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock