Code help
I have a table as shown below, I want to create another one that put all
Territory together into one cell that corresponding to unique County. County Territory Bell 0033 Bell 0036 Bell 0034 Boone 0052 Boone 0053 Boone 0055 Boone 0046 Boone 0054 County Territory Bell 0031, 0034, 0036 Boone 0052, 0053, 0055, 0046, 0054 My VB skill is very limited:( My code is: Sub Union() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error Resume Next Dim iRows As Long, mRow As Long, ir As Integer, ic As Integer, rng As Range iRows = Selection.Rows.Count Set Lastcell = Cells.SpecialCells(xlLastCell) mRow = Lastcell.Row If mRow < iRows Then iRows = mRow Set rng = ActiveSheet.Range(G1, H26) For ic = 1 To 26 County = rng.Item(ic, 1).Value Terr = rng.Item(ic, 2).Value For ir = 1 To iRows Combined = Selection.Item(ir, 2).Value Compared = Trim(Selection.Item(ir, 1).Value) If County = Compared Then Terr = Terr & ", " & Combined Next ir Next ic Application.ScreenUpdating = True End Sub Please help. Thanks, |
Code help
Lots of times when you're inserting or deleting rows, it's much easier to start
at the bottom and work your way to the top. Option Explicit Sub testme() Dim iRow As Long Dim LastRow As Long Dim FirstRow As Long With Worksheets("sheet1") FirstRow = 2 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row For iRow = LastRow To FirstRow + 1 Step -1 If LCase(Trim(.Cells(iRow, "A").Value)) _ = LCase(Trim(.Cells(iRow - 1, "A").Value)) Then 'same, so do some work .Cells(iRow - 1, "B").Value _ = .Cells(iRow - 1, "b").Value _ & ", " & .Cells(iRow, "b").Value .Rows(iRow).Delete End If Next iRow End With End Sub Save your work first--since it deletes the old rows. Lily wrote: I have a table as shown below, I want to create another one that put all Territory together into one cell that corresponding to unique County. County Territory Bell 0033 Bell 0036 Bell 0034 Boone 0052 Boone 0053 Boone 0055 Boone 0046 Boone 0054 County Territory Bell 0031, 0034, 0036 Boone 0052, 0053, 0055, 0046, 0054 My VB skill is very limited:( My code is: Sub Union() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error Resume Next Dim iRows As Long, mRow As Long, ir As Integer, ic As Integer, rng As Range iRows = Selection.Rows.Count Set Lastcell = Cells.SpecialCells(xlLastCell) mRow = Lastcell.Row If mRow < iRows Then iRows = mRow Set rng = ActiveSheet.Range(G1, H26) For ic = 1 To 26 County = rng.Item(ic, 1).Value Terr = rng.Item(ic, 2).Value For ir = 1 To iRows Combined = Selection.Item(ir, 2).Value Compared = Trim(Selection.Item(ir, 1).Value) If County = Compared Then Terr = Terr & ", " & Combined Next ir Next ic Application.ScreenUpdating = True End Sub Please help. Thanks, -- Dave Peterson |
Code help
This is SO Cool! It works perfectly. Thanks a million!
Lily "Dave Peterson" wrote: Lots of times when you're inserting or deleting rows, it's much easier to start at the bottom and work your way to the top. Option Explicit Sub testme() Dim iRow As Long Dim LastRow As Long Dim FirstRow As Long With Worksheets("sheet1") FirstRow = 2 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row For iRow = LastRow To FirstRow + 1 Step -1 If LCase(Trim(.Cells(iRow, "A").Value)) _ = LCase(Trim(.Cells(iRow - 1, "A").Value)) Then 'same, so do some work .Cells(iRow - 1, "B").Value _ = .Cells(iRow - 1, "b").Value _ & ", " & .Cells(iRow, "b").Value .Rows(iRow).Delete End If Next iRow End With End Sub Save your work first--since it deletes the old rows. Lily wrote: I have a table as shown below, I want to create another one that put all Territory together into one cell that corresponding to unique County. County Territory Bell 0033 Bell 0036 Bell 0034 Boone 0052 Boone 0053 Boone 0055 Boone 0046 Boone 0054 County Territory Bell 0031, 0034, 0036 Boone 0052, 0053, 0055, 0046, 0054 My VB skill is very limited:( My code is: Sub Union() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error Resume Next Dim iRows As Long, mRow As Long, ir As Integer, ic As Integer, rng As Range iRows = Selection.Rows.Count Set Lastcell = Cells.SpecialCells(xlLastCell) mRow = Lastcell.Row If mRow < iRows Then iRows = mRow Set rng = ActiveSheet.Range(G1, H26) For ic = 1 To 26 County = rng.Item(ic, 1).Value Terr = rng.Item(ic, 2).Value For ir = 1 To iRows Combined = Selection.Item(ir, 2).Value Compared = Trim(Selection.Item(ir, 1).Value) If County = Compared Then Terr = Terr & ", " & Combined Next ir Next ic Application.ScreenUpdating = True End Sub Please help. Thanks, -- Dave Peterson |
All times are GMT +1. The time now is 04:35 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com