Excel Sheet to separate by Region

gregtgonzalez

New Member
Joined
Dec 16, 2016
Messages
29
Hello guys!
I am a novice with excel and trying to learn VBA to assist in project that has landed in my lap.

Here is what i have to do: I need to build an excel workbook that would allow us to assign incoming referrals to the correct region they belong to (assigned by state), while still being able to track the call attempts made.

i.e. all clients that reside in "CA" are in the "Western Region" the region values are already assigned on the spread sheet as the last column and auto populates based on the state information they live in. "FL" is in the Eastern Region "TX" in the central region.

There are Three "Regions"

What I am trying to do is build an excel spread sheet where we input the daily referrals in the "raw data sheet" (sheet 1) and they get disbursed into the appropriate territory tab.

i.e. tab 1 would be raw data, tab 2 would be Western Region, tab 2 Central Region, and tab 3 Eastern region.​



I recorded a Macro that would filter all the items by region and then copy them to the appropriate sheet in the workbook. However, the macro keeps replacing the info that was already brought over, I need the macro to only bring over the new data starting at the next open line in the appropriate territory tab.

Example
Case Number State Territory
Case1234 CA Western
case5678 TX Central
Case9101 FL Eastern

However this is multiplied by 100s of cases, what i would like is for the macro to filter the ones from each respective territory and transfer the values to the correct Territory Tab, while deleting them from the "raw data" tab. I would like to be able to do this multiple times, as we get "raw data" in daily and have the information transferred into the next open row in the territory tab. Then deleting the information from the raw data, as it is no loner necessary.

This is the recorded macro I have so far
Sub westernregion()
'
' westernregion Macro
'


'
Sheets("RAWDATA ").Select
ActiveSheet.Range("$B$1:$T$208").AutoFilter Field:=19, Criteria1:="WESTERN"
Range("B2:T29").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Sheets("WEST REGION").Select
Range("B2").Select
Sheets("RAWDATA ").Select
Selection.Copy
Sheets("WEST REGION").Select
ActiveSheet.Paste
End Sub
 
Hello Greg,
You're welcome. I'm glad that I was able to help.

Following is a run-down of the code:-

- The first line is the name of the macro. Call it what you like but you won't be able to use Excel reserved words. There is a fair list of reserved words but you will receive a message warning you of this if you inadvertently use a reserved word.

- The next three lines you should be familiar with: declaring the variables.

- The following line:-

Code:
ar = Array("Western", "Central", "Eastern")
sets the array values. It is a one dimensional array. In this case, its the criteria which you wish to use to divide the data into the individual sheets of the same names. Arrays are a really good way of storing/manipulating data, are very efficient and help codes to run smoothly and very quickly.

- The next two lines:-
Code:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
are used to make the code more efficient. Here ScreenUpdating=False (turns this application off) will prevent screen flicker as Excel runs through the code and does any calculations. DisplayAlerts = False will prevent Excel from bringing up a warning telling you that data will be lost if rows are deleted (when the delete line of code is executed).

- The following line:-

Code:
For i = 0 to UBound(ar)

sets the boundaries of the array from Western to Eastern (from its lower bounds to its upper bounds) and begins the loop for each criteria. It could also be written as:-

Code:
For i= LBound(ar) to UBound(ar)

To Excel, it would look something like this:-

ar=Variant(0 to 2)

ar(0)
ar(1)
ar(2)
(if you recall, at the beginning of the code, ar was declared as the data type "Variant").

A 1D array will always begin with zero(0)

This line:-

Code:
Sheet1.Range("R1", Sheet1.Range("R" & Sheet1.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0

is used to filter all of Column R for the criteria ["Western", "Central, "Eastern" (or ar(i)]. The "7" is the numeric value for xlFilterValues and the "0" keeps the little drop downs hidden on each column.

The following line:-
Code:
 lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

I'm sure you know finds the last row of data based on Column A (which is generally assumed to be the longest column of data).

The next line:-

Code:
If lr > 1 Then

is used as a check in this case. It will ensure that row 1 (Headings) is the last row when data is deleted so that the headings won't be deleted.

The next two lines:-

Code:
Sheet1.Range("A2", Sheet1.Range("I" & Sheet1.Rows.Count).End(xlUp)).Copy
         Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues

are the copy/paste lines as you can tell with only values being transferred (just in case you have formulae in any row). You can see that the sheets are referred to by their array values, Sheets (ar(i), so that the data is transferred to the relevant sheet. Data from Columns A:I is transferred only. You can expand or contract this range to suit of course.

The next line:-

Code:
Sheet1.Range("R2", Sheet1.Range("R" & Sheet1.Rows.Count).End(xlUp)).EntireRow.Delete

as you can tell is the delete line of code.

The next line:-

Code:
Sheets(ar(i)).Columns.AutoFit

auto fits the data in each column in the individual sheets to which data has been transferred.

The "End If" lines closes off the If statement (If lr > 1).

"Next i" continues the iterations through the criteria.

This line:_
Code:
[R1].AutoFilter

turns the auto filter off.

The remaining lines should be fairly obvious.

You can wake up now Greg! I hope this helps.

Cheerio,
vcoolio.
 
Last edited:
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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