Spawn Rows to New Sheets with Validation

C

chefdt

Board Regular
Joined
Jul 1, 2008
Messages
163
One of you helped me with the following Macro. It takes a Worksheet (Combined) and distributes it's rows to newly created spreadsheets based on the data in column (B).

As you can see, it also performs some basic fomula calcs on each new sheet.

Sub DistributeRowsMA()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim i As Long

Set wsAll = Worksheets("Combined") ' change All to the name of the worksheet the existing data is on

LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row

Set wsCrit = Worksheets.Add

' column B has the criteria eg project ref
wsAll.Range("B1:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRowCrit

Set wsNew = Worksheets.Add
wsNew.Name = wsCrit.Range("A2")
wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
wsCrit.Rows(2).Delete

With wsNew
.Range("L2").Resize(.UsedRange.Rows.Count - 1).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
.Range("N2").Resize(.UsedRange.Rows.Count - 1).FormulaR1C1 = "=(RC[-2])-(RC[-8])"
End With


Next i

Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True

End Sub


Here is a partial from the worksheet that is distributed.....

Combined


<TABLE style="PADDING-RIGHT: 2pt; PADDING-LEFT: 2pt; FONT-SIZE: 10pt; FONT-FAMILY: Arial,Arial; BACKGROUND-COLOR: #ffffff" cellSpacing=0 cellPadding=0 border=1><COLGROUP><COL style="FONT-WEIGHT: bold; WIDTH: 30px"><COL style="WIDTH: 46px"><COL style="WIDTH: 101px"><COL style="WIDTH: 49px"><COL style="WIDTH: 244px"></COLGROUP><TBODY><TR style="FONT-WEIGHT: bold; FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center"><TD></TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD></TR><TR style="HEIGHT: 51px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">1</TD><TD style="FONT-WEIGHT: bold; BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center">TerrID</TD><TD style="FONT-WEIGHT: bold; BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center">MA</TD><TD style="FONT-WEIGHT: bold; BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center">CustID</TD><TD style="FONT-WEIGHT: bold; BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center">Cust Name</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">2</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">334508</TD><TD style="FONT-SIZE: 9pt">ABUELITA ROSAS MEX. REST. +++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">3</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">042218</TD><TD style="FONT-SIZE: 9pt">VAN'S PIG STAND #1 ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">4</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">223289</TD><TD style="FONT-SIZE: 9pt">THE GOLDEN RULE HOME, INC. ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">5</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">417998</TD><TD style="FONT-SIZE: 9pt">RAINBOW INN OF OKLAHOMA ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">6</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">328583</TD><TD style="FONT-SIZE: 9pt">KICKAPOO CASINO +++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">7</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">449769</TD><TD style="FONT-SIZE: 9pt">KICKAPOO COMMUNITY CHILD CAR++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">8</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">472563</TD><TD style="FONT-SIZE: 9pt">MCLOUD CAFE ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">9</TD><TD>SAC</TD><TD>ABLA </TD><TD style="FONT-SIZE: 9pt; TEXT-ALIGN: right">163949</TD><TD style="FONT-SIZE: 9pt">SUNRISE REST. ++</TD></TR></TBODY></TABLE>




Now I would like the macro to look at another sheet to verify the existance of customers. The new code will ONLY distribute the rows, if the customer can be found on the Worksheet (Cust Type).

Here is an example from (Cust Type)
Sheet1


<TABLE style="PADDING-RIGHT: 2pt; PADDING-LEFT: 2pt; FONT-SIZE: 10pt; FONT-FAMILY: Arial,Arial; BACKGROUND-COLOR: #ffffff" cellSpacing=0 cellPadding=0 border=1><COLGROUP><COL style="FONT-WEIGHT: bold; WIDTH: 30px"><COL style="WIDTH: 56px"><COL style="WIDTH: 223px"></COLGROUP><TBODY><TR style="FONT-WEIGHT: bold; FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center"><TD> </TD><TD>A</TD><TD>B</TD></TR><TR style="HEIGHT: 46px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">1</TD><TD style="FONT-WEIGHT: bold; TEXT-ALIGN: center">Cust #</TD><TD style="FONT-WEIGHT: bold; TEXT-ALIGN: center">Customer Name</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">2</TD><TD style="TEXT-ALIGN: center">10496</TD><TD>Adair Central Kitchen</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">3</TD><TD style="TEXT-ALIGN: center">10538</TD><TD>Advance Food Company ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">4</TD><TD style="TEXT-ALIGN: center">11106</TD><TD>Anadarko Public Schools +</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">5</TD><TD style="TEXT-ALIGN: center">11726</TD><TD>Integris Bass Bapt Ctr +++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">6</TD><TD style="TEXT-ALIGN: center">11866</TD><TD>Jim'S Rest ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">7</TD><TD style="TEXT-ALIGN: center">11973</TD><TD>Old Germany Rest +</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">8</TD><TD style="TEXT-ALIGN: center">12153</TD><TD>Dunn'S Food Center</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">9</TD><TD style="TEXT-ALIGN: center">12468</TD><TD>Blue Moon ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">10</TD><TD style="TEXT-ALIGN: center">12534</TD><TD>Bob Davis Fish Mkt ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">11</TD><TD style="TEXT-ALIGN: center">12682</TD><TD>Boulevard Cafeteria +</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">12</TD><TD style="TEXT-ALIGN: center">13110</TD><TD>Chi Omega ++</TD></TR><TR style="HEIGHT: 17px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">13</TD><TD style="TEXT-ALIGN: center">13300</TD><TD>Brothers Rest +</TD></TR></TBODY></TABLE>


Any help would be appreciated....

Dale
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
You must log in or register to reply here.

Similar threads

E
  • Question
Adding a custom message.
Replies
1
Views
420
Micron
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
V
  • Question
Issue with scraping with VBA
Replies
1
Views
488
John_w
J
E
  • Question
Query in excel to Outlook mail take rows with name until next name
Replies
0
Views
343
esben
E

Forum statistics

Threads
1,214,525
Messages
6,120,051
Members
448,940
Latest member
mdusw

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