Solved segregating data in different tabs based on a row value

May 3, 2012 at 04:59:30
Specs: Windows 7
Hi all,
So here is the tuff nut for me:

I have a huge file as the attached sample data. I need to segregate row#4 to 27 in a tab based on location value as mentioned in A2. Similary, row# 44 to 75 based on A42. Basically, I need to move the individual location data in different tabs. So the number of locations on the sheet should have that many different tabs holding respective data for them. For e.g- Location Code: 161 should have entire row# 4 to 27 data on 1 tab and 152 should have a different tab and so forth.

Thanks in advance for all your suggestions!

Kris

Location Code : 161 Location : 1100 Paschim Vihar

Controllable Total Events Rejection Percentage Rejection Percentage to Controllable
Auto Expired 1 0.24% 1.43%
Data Error - ACS 22 5.30% 31.43%
Operator Error - ACS 1 0.24% 1.43%
Plate Clarity 7 1.69% 10.00%
Undeterminable 39 9.40% 55.71%
Totals : 70 16.87% 100.00%

No Violation Total Events Rejection Percentage Rejection Percentage to No Violation
Miscellaneous Not-Citable 11 2.65% 100.00%
Totals : 11 2.65% 100.00%

Uncontrollable Total Events Rejection Percentage Rejection Percentage to Uncontrollable
DMV No-Hit 2 0.48% 3.51%
Environmental Glare 4 0.96% 7.02%
Multiple Vehicles 1 0.24% 1.75%
No Plate 2 0.48% 3.51%
Plate Not-Citable 19 4.58% 33.33%
Plate Obstructed 10 2.41% 17.54%
Police-Emergency Response 6 1.45% 10.53%
Police-Non Emergency 3 0.72% 5.26%
Vehicle Mismatch 6 1.45% 10.53%
Vehicle Obstructed 4 0.96% 7.02%
Totals : 57 13.73% 100.00%

Totals % to Total Events
Total Events : 415 100.00%
Total Violations : 404 97.35%
Total In Process : 0 0%
Total of All Site Rejects : 138 33.25%
Total Site No Violation : 11 2.65%
Total Site Controllable Rejects : 70 16.87%
Total Site Uncontrollable Rejects : 57 13.73%
Total Issued : 277 66.75%
Yield : 66.75%
Overall Issuance Rate : 68.56%
Controllable Issuance Rate : 79.83%

Location Code : 152 Location : 1200 Sarojini Nagar

Controllable Total Events Rejection Percentage Rejection Percentage to Controllable
Environment Clarity 1 0.42% 25.00%
Expired - ACS 1 0.42% 25.00%
Plate Clarity 1 0.42% 25.00%
Undeterminable 1 0.42% 25.00%
Totals : 4 1.69% 100.00%

No Violation Total Events Rejection Percentage Rejection Percentage to No Violation
Miscellaneous Not-Citable 2 0.85% 22.22%
No Violation Occurred 7 2.97% 77.78%
Totals : 9 3.81% 100.00%

Uncontrollable Total Events Rejection Percentage Rejection Percentage to Uncontrollable
DMV No-Hit 3 1.27% 21.43%
Plate Not-Citable 7 2.97% 50.00%
Plate Obstructed 2 0.85% 14.29%
Police-Non Emergency 1 0.42% 7.14%
Vehicle Mismatch 1 0.42% 7.14%
Totals : 14 5.93% 100.00%

Totals % to Total Events
Total Events : 236 100.00%
Total Violations : 227 96.19%
Total In Process : 0 0%
Total of All Site Rejects : 27 11.44%
Total Site No Violation : 9 3.81%
Total Site Controllable Rejects : 4 1.69%
Total Site Uncontrollable Rejects : 14 5.93%
Total Issued : 209 88.56%
Yield : 88.56%
Overall Issuance Rate : 92.07%
Controllable Issuance Rate : 98.12%


See More: segregating data in different tabs based on a row value

Report •


✔ Best Answer
May 7, 2012 at 18:52:32
Try this code.

It assumes that the data to be copied resides in Sheet1.

Option Explicit
Sub LocationData()
Dim c, rng As Range
Dim lastRw, startAt, locStart, locEnd As Long
Dim firstAddress, locCode As String
'Insert Rows and add string to Force Find to top of sheet
 Sheets(1).Rows("1:3").EntireRow.Insert
 Sheets(1).Range("A1") = "This Resets Find To Top Of Sheet"
  Set c = Cells.Find("This Resets Find To Top Of Sheet")
'Find Last Row with data in Column B
   lastRw = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row + 2
'Add string to last row so Find can determne length of last section to copy
    Sheets(1).Range("B" & lastRw) = "Location Code"
      With Sheets(1).Range("B1:J" & lastRw)
'Find "Location Code" string in Column B
       Set c = .Find(what:="Location Code", LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            firstAddress = c.Address
            startAt = c.Row
            Do
'If Location Code is found in last Row, then clean up sheet and exit
             If c.Row = lastRw Then
              Sheets(1).Rows(lastRw).EntireRow.Delete
              Sheets(1).Rows("1:3").EntireRow.Delete
              MsgBox "Done!"
              Exit Sub
             End If
'Extract Location Code number from cell where Location Code was found
          locStart = WorksheetFunction.Find(":", Range(c.Address)) + 2
          locEnd = WorksheetFunction.Find("Location", Range(c.Address), 3) - 2
            locCode = Mid(Range(c.Address), locStart, locEnd - locStart + 1)
'Add new sheet and name it after Location Code number
              Sheets.Add After:=Sheets(Sheets.Count)
              Sheets(Sheets.Count).Name = locCode
'Find the next occurance of Location Code
'Use it set range to be copied
                Set c = .FindNext(c)
                 Set rng = .Cells(startAt, 1).Resize(c.Row - startAt - 1)
'Copy the range to the sheet named for the Location Code
                  rng.Copy Destination:=Sheets(locCode).Range("A1")
                  startAt = c.Row
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
      End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
May 3, 2012 at 08:09:23
Since macros need to be very specific about where they find data, we need more specifics related to your example data.

You did not include Row or Column labels, so we can't offer anything specific at this point.

Let me take a guess at what you are looking for and you can fix whatever I get wrong.

1 - In Column A, you have the text Location Code : in various cells.
2 - In Column B, on the same Row as Location Code : you have a value, e.g. 161, 152, etc.
3 - Skipping one blank Row after the Location Code :, you have data that extends down to 1 blank Row above the next occurrence of Location Code :.
4 - Each time the text Location Code : is found in Column A, you want to create a new tab, named for the Location Code : found in Column B of that Row.
5 - Once the new tab is created, you want to copy the data mentioned in Step 3 above to that tab.

Assuming I've got most of that right, I have some questions:

Will any Location Codes be repeated, meaning that more one set of data will need to be copied to the same tab?

Is this a one time thing or an on-going process where data sets will need to be pasted below existing data sets on tabs that already exist?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
May 4, 2012 at 02:07:56
Ok Derby thanks for putting this together and here is the background:
We have a tool that pulls these reports in pdf or excel format and the client wants to see data for each of the locations on different tabs in excel format.
Now to answer your questions:
This is a repetitive activity. So they would run the tool whenever needed and would like to have a macro or something wherein they can dump the data and just hit run to get it broken down into different tabs based on the locations.
There would be only one occurence of a particular location everytime the data is pulled, meaning location not repeated So only 1 set of data per location.
Step 1&2 above needs a little correction. Column A is blank & column B holds "Location Code : 161 Location : 1100 Blk of Mace Ave SB" together with cells merged from B to J.
Steps 3,4 & 5 look correct to me.

Thanks again and am eagerly waiting for a solution here

Kris

P.S. pls let me know if in anyway I can upload a sample excel for your ref. The pre thing above doesnt work for me.


Report •

#3
May 4, 2012 at 08:09:34
re: "This is a repetitive activity."

You have partially answered my question. "Repetitive" can be taken two ways:

1 - Each time the macro is run, it is actually a "one time run" against the new report, creating new sheets and copying data as if the old workbook and all it's sheets and data didn't exist.

or

2 - Each time the macro is run, the data from the new report is appended to the data in existing sheets - if a sheet exists for a given Location Code - or a new sheet is added if the Location Code didn't exist before.

Do you see how those things are different? How the code would handle those 2 situations would be need to be different.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
May 5, 2012 at 21:21:05
I meant the type 1.
Each time the macro is run, it is actually a "one time run" against the new report, creating new sheets and copying data as if the old workbook and all it's sheets and data didn't exist. The client would pull data from tool and create new sheets using our macro.
please advise.
Thanks!
Kris

Report •

#5
May 7, 2012 at 18:52:32
✔ Best Answer
Try this code.

It assumes that the data to be copied resides in Sheet1.

Option Explicit
Sub LocationData()
Dim c, rng As Range
Dim lastRw, startAt, locStart, locEnd As Long
Dim firstAddress, locCode As String
'Insert Rows and add string to Force Find to top of sheet
 Sheets(1).Rows("1:3").EntireRow.Insert
 Sheets(1).Range("A1") = "This Resets Find To Top Of Sheet"
  Set c = Cells.Find("This Resets Find To Top Of Sheet")
'Find Last Row with data in Column B
   lastRw = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row + 2
'Add string to last row so Find can determne length of last section to copy
    Sheets(1).Range("B" & lastRw) = "Location Code"
      With Sheets(1).Range("B1:J" & lastRw)
'Find "Location Code" string in Column B
       Set c = .Find(what:="Location Code", LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            firstAddress = c.Address
            startAt = c.Row
            Do
'If Location Code is found in last Row, then clean up sheet and exit
             If c.Row = lastRw Then
              Sheets(1).Rows(lastRw).EntireRow.Delete
              Sheets(1).Rows("1:3").EntireRow.Delete
              MsgBox "Done!"
              Exit Sub
             End If
'Extract Location Code number from cell where Location Code was found
          locStart = WorksheetFunction.Find(":", Range(c.Address)) + 2
          locEnd = WorksheetFunction.Find("Location", Range(c.Address), 3) - 2
            locCode = Mid(Range(c.Address), locStart, locEnd - locStart + 1)
'Add new sheet and name it after Location Code number
              Sheets.Add After:=Sheets(Sheets.Count)
              Sheets(Sheets.Count).Name = locCode
'Find the next occurance of Location Code
'Use it set range to be copied
                Set c = .FindNext(c)
                 Set rng = .Cells(startAt, 1).Resize(c.Row - startAt - 1)
'Copy the range to the sheet named for the Location Code
                  rng.Copy Destination:=Sheets(locCode).Range("A1")
                  startAt = c.Row
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
      End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Ask Question