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
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Hello Greg,

See if the following code helps:-

Code:
Sub TransferData()
    Dim ar As Variant, i As Integer, lr As Long
ar = [{"Western","Central","Eastern";"Western","Central", "Eastern"}]
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For i = 1 To UBound(ar, 2)
        With Sheet1
            .AutoFilterMode = False
                With Range("J1", Range("J" & Rows.Count).End(xlUp))
                    .AutoFilter 1, ar(2, i), 7, , 0
                    lr = Sheet1.Range("J" & Rows.Count).End(xlUp).Row
                    If lr > 1 Then
                    Range("A2", Range("I" & Rows.Count).End(xlUp)).Copy
                    Sheets(ar(1, i)).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
                    Range("A2", Range("I" & Rows.Count).End(xlUp)).Delete
                    Sheets(ar(1, i)).Columns.AutoFit
                    End If
             End With
     End With
Next i
Sheet1.[J1].AutoFilter
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "STATUS"
End Sub

Following is the link to my test workbook which assumes a set out similar to yours:-

https://www.dropbox.com/s/7dh97flscgooi8g/GregTGonzalez(Master sht to multi shts).xlsm?dl=0

Click on the "RUN" button to see it work. I've assumed that your data stretches out to Column I with the criteria in Column J. you may have to change the ranges to suit yourself.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
THANK YOU SO MUCH VCOOLIO!
Unfortunately when the button is pushed is not correctly transferring the info.
when i opened your workbook, the data is being sorted and only being correctly transferred to the "central" tab and not to the other tabs.
my data ranges from A2: Q2 (A1:Q1 are headers) and the "region" data is in column "R".
i redid the ranges to accomodate for my data, the first time i hit teh button it worked awesome. but when i pasted additional information it would not sort the newly input lines.
any suggestions on how to fix this?

again thank you SO much i really do appreciate your help!
 
Upvote 0
Hello Greg,

I don't know what is going on at your end but I have just tested the code at the link above and in my personal file and all is working perfectly. I also extended the data to the ranges you specified and all still works perfectly and when I added new data to the Raw Data sheet, it still worked perfectly.

The code doesn't do any sorting, it filters the data.

But before we all break down and cry, try the following version of the code in a copy of your work book:-


Code:
Sub TransferData2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        
ar = Array("Western", "Central", "Eastern")
  
  For i = 0 To UBound(ar)
         Sheet1.Range("R1", Sheet1.Range("R" & Sheet1.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0
         lr = Sheet1.Range("R" & Rows.Count).End(xlUp).Row
         If lr > 1 Then
         Sheet1.Range("A2", Sheet1.Range("Q" & Sheet1.Rows.Count).End(xlUp)).Copy
         Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
         Sheet1.Range("A2", Sheet1.Range("Q" & Sheet1.Rows.Count).End(xlUp)).Delete
         Sheets(ar(i)).Columns.AutoFit
         End If
    Next i
[R1].AutoFilter
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"
End Sub

There is not much difference between the two codes, just how the array is referenced.

If it still doesn't quite work for you then it would be best if you uploaded a sample of your workbook (be careful with any sensitive data) to a free file sharing site such as DropBox then post the link to your file back here. We'll then try to sort it out for you.

Cheerio,
vcoolio.

P.S.: Is Sheet1 the Raw Data sheet in your workbook?
 
Last edited:
Upvote 0
sorry i thought i posted this hours ago.
thank you for your help, however, the issue i am having now is the code is copying the headers and pasting on the "Western" tab....
here is the drop box link.
the region is assigned with a vlookup for the state and its region.
here is sample of my data. it sounds like you have the correct information. and yes the first sheet is the "raw data sheet"

https://www.dropbox.com/s/mt3vz9v2b10k48y/gregtgonzalez project review.xlsm?dl=0
 
Upvote 0
Hello Greg,

Could you try again please. They have all been deleted!

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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