Sub CopyDataByCity()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Long
Dim i As Long
Dim citiesToFilter() As Variant
Dim city As Variant
Dim headerRow As Range
Dim currentRow As Long
' Set the source sheet
Set sourceSheet = ThisWorkbook.Sheets("Portfolio Summary")
' Set the target sheet
Set targetSheet = ThisWorkbook.Sheets("RAW DATA")
' Define the list of cities to filter on in the desired order
citiesToFilter = Array("Jacksonville, FL", "Houston-The Woodlands-Sugar Land, TX", "Seattle-Tacoma-Bellevue, WA", "Minneapolis-St. Paul-Bloomington, MN-WI", "San Antonio-New Braunfels, TX", "Portland-Vancouver-Hillsboro, OR-WA", "Philadelphia-Camden-Wilmington, PA-NJ-DE-MD", "Boston-Cambridge-Newton, MA-NH", "Nashville-Davidson--Murfreesboro--Franklin, TN", "Columbus, OH", "Indianapolis-Carmel-Anderson, IN", "Raleigh-Cary, NC", "Cincinnati, OH-KY-IN", "Richmond, VA", "Urban Honolulu, HI", "Greensboro-High Point, NC", "Sacramento-Roseville-Folsom, CA", "Colorado Springs, CO", "Stockton, CA", "San Jose-Sunnyvale-Santa Clara, CA", "Harrisburg-Carlisle, PA", "San Francisco-Oakland-Berkeley, CA", "Louisville/Jefferson County, KY-IN", "Reno, NV", "Lakeland-Winter Haven, FL", "San Diego-Chula Vista-Carlsbad, CA", "Fort Collins, CO", "Salt Lake City, UT", "Boulder, CO", "Kansas City, MO-KS", "Baltimore-Columbia-Towson, MD", "Memphis, TN-MS-AR", "Tallahassee, FL", "North Port-Sarasota-Bradenton, FL", "Tucson, AZ")
' Find the last row of data in the source sheet
lastRow = sourceSheet.Cells(Rows.Count, "A").End(xlUp).Row
' Get the header row
Set headerRow = sourceSheet.Range("6:6")
' Set the starting row in the target sheet
currentRow = 2 ' Assuming the header row is in row 1
' Loop through the cities to filter on in the desired order
For Each city In citiesToFilter
    ' Loop through the rows in the source sheet
    For i = 8 To lastRow ' Assuming the header row is in row 7
        ' Check if the city name in column Q matches the current city
        If sourceSheet.Cells(i, "Q").Value = city Then
            ' If the city name matches, copy the specified columns and paste into the target sheet
            targetSheet.Range("A" & currentRow).Value = sourceSheet.Cells(i, "C").Value ' Copy column
            targetSheet.Range("B" & currentRow).Value = sourceSheet.Cells(i, "H").Value ' Copy column
            targetSheet.Range("C" & currentRow).Value = sourceSheet.Cells(i, "D").Value ' Copy column
            targetSheet.Range("D" & currentRow).Value = sourceSheet.Cells(i, "S").Value ' Copy column
            targetSheet.Range("E" & currentRow).Value = sourceSheet.Cells(i, "I").Value ' Copy column
            targetSheet.Range("F" & currentRow).Value = sourceSheet.Cells(i, "R").Value ' Copy column
            targetSheet.Range("G" & currentRow).Value = sourceSheet.Cells(i, "W").Value ' Copy column
            targetSheet.Range("H" & currentRow).Value = sourceSheet.Cells(i, "N").Value ' Copy column
            targetSheet.Cells(currentRow, "I").Value = city ' Paste the city name to column I in the target sheet
            currentRow = currentRow + 1 ' Increment the current row variable
        End If
        
        ' Check if the next row is blank or if the city changes
        If sourceSheet.Cells(i + 1, "A").Value = "" Or sourceSheet.Cells(i + 1, "Q").Value <> city Then
            ' If the next row is blank or if the city changes, skip over it
            i = i + 1
        End If
    Next i
Next city
End Sub

citiesToFilter = Array("Jacksonville, FL", "Houston-The Woodlands-Sugar Land, TX", _
                "Seattle-Tacoma-Bellevue, WA", (...)

Function getCityList() As String()
    Dim cityList(1 to 200) as String
    cityList(1) = "Jacksonville, FL"
    cityList(2) = "Houston-The Woodlands-Sugar Land, TX"
    cityList(3) = "Seattle-Tacoma-Bellevue, WA"
    (...)
    getCityList = cityList
End Function

Function getCityList() As Variant       
    Dim cityList 
    cityList= ThisWorkbook.Sheets("CityList").Range("CityList").Value
    getCityList = cityList 
End Function

Function getCityList() As String()        
    Dim sheetValues As Variant, i As Long
    sheetValues = ThisWorkbook.Sheets("CityList").Range("CityList").Value
    ReDim cityList(1 To UBound(sheetValues, 1)) As String
    For i = 1 To UBound(sheetValues, 1)
        cityList(i) = sheetValues(i, 1)
    Next
    getCityList = cityList
End Function

Sub test()
Dim sourceSheet As Worksheet, targetSheet As Worksheet
Dim rgS As Range, rgT As Range, rgR As Range
Dim citiesToFilter, el, arrCol, col
Set sourceSheet = ThisWorkbook.Sheets("Portfolio Summary")
Set rgS = sourceSheet.Range("Q8", sourceSheet.Range("Q" & Rows.Count).End(xlUp))
Set targetSheet = ThisWorkbook.Sheets("RAW DATA")
Set rgT = targetSheet.Range("A2")
citiesToFilter = Array("Jacksonville, FL", "Houston-The Woodlands-Sugar Land, TX", "Seattle-Tacoma-Bellevue, WA", "Minneapolis-St. Paul-Bloomington, MN-WI", "San Antonio-New Braunfels, TX", "Portland-Vancouver-Hillsboro, OR-WA", "Philadelphia-Camden-Wilmington, PA-NJ-DE-MD", "Boston-Cambridge-Newton, MA-NH", "Nashville-Davidson--Murfreesboro--Franklin, TN", "Columbus, OH", "Indianapolis-Carmel-Anderson, IN", "Raleigh-Cary, NC", "Cincinnati, OH-KY-IN", "Richmond, VA", "Urban Honolulu, HI", "Greensboro-High Point, NC", "Sacramento-Roseville-Folsom, CA", "Colorado Springs, CO", "Stockton, CA", "San Jose-Sunnyvale-Santa Clara, CA", "Harrisburg-Carlisle, PA", "San Francisco-Oakland-Berkeley, CA", "Louisville/Jefferson County, KY-IN", "Reno, NV", "Lakeland-Winter Haven, FL", "San Diego-Chula Vista-Carlsbad, CA", "Fort Collins, CO", "Salt Lake City, UT", "Boulder, CO", "Kansas City, MO-KS", "Baltimore-Columbia-Towson, MD", "Memphis, TN-MS-AR", "Tallahassee, FL", "North Port-Sarasota-Bradenton, FL", "Tucson, AZ")
arrCol = Array("C", "H", "D", "S", "I", "R", "W", "N")
For Each el In citiesToFilter
    With rgS
        If .Find(el, lookat:=xlWhole) Is Nothing Then GoTo nxtEL:
        .Replace el, True, xlWhole, , False, , False, False
        Set rgR = .SpecialCells(xlConstants, xlLogical)
        .Replace True, el, xlWhole, , False, , False, False
    End With
    For Each cell In rgR
        For Each col In arrCol
            rgT.Value = sourceSheet.Range(col & cell.Row).Value
            Set rgT = rgT.Offset(0, 1)
        Next
    Set rgT = rgT.Offset(1, 0).End(xlToLeft)
    Next
nxtEL:
Next el
End Sub