Column Change

vmjan02

Well-known Member
Joined
Aug 15, 2012
Messages
1,132
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
I have this data and not sure if there is a way to get the output.

eg:- Row no 3 have a name and with respect to row 4 the nex 5 rows has its left and right, so in single line with respect ot row 3 ti will have data for 4 and 5.
so in singel ine row 3 will have its all detils,

I tried differnt ways but no help any way to fix it a vba will do.


I am confused how to explain it but I hope this table will give the right view.




Book1
BCDEFGH
1
2Output
3Bundle-Ether10 Gi101/0/0/4 Local Configured 0x8000 Gi102/0/0/4 Local Active 0x8000
4 Gi101/0/0/4 Local Configured 0x8000 0x0000 1000000
5 Gi102/0/0/4 Local Active 0x8000 0x0000 1000000
6Bundle-Ether20 Gi100/0/0/5 Local Configured 0x8000 Gi101/0/0/5 Local Configured 0x8000
7 Gi100/0/0/5 Local Configured 0x8000 0x0000 1000000
8 Gi101/0/0/5 Local Configured 0x8000 0x0000 1000000
9Bundle-Ether1001
10 Te0/2/0/28 Local Active 0x8000 0x0000 10000000 Te0/2/0/28 Local Active 0x8000 Te0/2/0/29 Local Active 0x8000 Te0/3/0/28 Local Active 0x8000 Te0/3/0/29 Local Active 0x8000
11 Te0/2/0/29 Local Active 0x8000 0x0000 10000000
12 Te0/3/0/28 Local Active 0x8000 0x0000 10000000
13 Te0/3/0/29 Local Active 0x8000 0x0000 10000000
14Bundle-Ether1002 Te0/2/0/38 Local Active 0x8000 Te0/2/0/39 Local Active 0x8000 Te0/3/0/38 Local Active 0x8000 Te0/3/0/39 Local Active 0x8000
15 Te0/2/0/38 Local Active 0x8000 0x0000 10000000
16 Te0/2/0/39 Local Active 0x8000 0x0000 10000000
17 Te0/3/0/38 Local Active 0x8000 0x0000 10000000
18 Te0/3/0/39 Local Active 0x8000 0x0000 10000000
Sheet1
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Hi vmjam02,

The VBA code below will run on column B and start adding the data in to column E...

VBA Code:
Sub MoveStuff()

Dim MatchRow As Integer
Dim MoveOffset As Integer
Dim ColLetter As String
Dim Frow As Integer
Dim Lrow As Integer

Frow = 3        '<<< Change this number depending on the row your data starts in
ColLetter = "E" '<<< Change this letter to the column you want to start adding the data in to

Lrow = Range("B" & Frow).End(xlDown).Row 'sets the last row in the data assuming there are no gaps in the data
MoveOffset = 0

For Each i In Range("B" & Frow & ":B" & Lrow)
    If i.Value Like "Bundle*" Then
    MatchRow = i.Row
    MoveOffset = 0
    Else
        Range(ColLetter & MatchRow).Offset(0, MoveOffset).Value = i.Value
        MoveOffset = MoveOffset + 1
        '>>> Remove the ' from the below to clear the cells as it goes
        'i.ClearContents
        '>>> Below will clear the 0x0000 100000 data
        'i.Offset(0, 1).ClearContents

    End If
Next i

End Sub

Change where indicated with <<< above either the start row and/or the column to start pasting the data in to.

Also added some code to clear data if it is not required, marked with >>>. To activate this remove the ' so it looks like the below...

VBA Code:
        '>>> Remove the ' from the below to clear the cells as it goes
        i.ClearContents
        '>>> Below will clear the 0x0000 100000 data
        i.Offset(0, 1).ClearContents

My results...
1701866618700.png


Result with the additional code activated...
1701866781154.png


Hope this works for you

Steven
 
Upvote 0
Other option with power query
SKU Customer Master - PS--15-06-2023 (002).xls
ABCDE
1FilterCustom.1Custom.2Custom.3Custom.4
2Bundle-Ether10 Gi101/0/0/4 Local Configured 0x8000 Gi102/0/0/4 Local Active 0x8000
3Bundle-Ether20 Gi100/0/0/5 Local Configured 0x8000 Gi101/0/0/5 Local Configured 0x8000
4Bundle-Ether1001 Te0/2/0/28 Local Active 0x8000 Te0/2/0/29 Local Active 0x8000 Te0/3/0/28 Local Active 0x8000 Te0/3/0/29 Local Active 0x8000
5Bundle-Ether1002 Te0/2/0/38 Local Active 0x8000 Te0/2/0/39 Local Active 0x8000 Te0/3/0/38 Local Active 0x8000 Te0/3/0/39 Local Active 0x8000
Table1


Here is the code
Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}}),
    #"Added Conditional Column" = Table.AddColumn(#"Changed Type", "Filter", each if [Column2] = null then [Column1] else null),
    #"Filled Down" = Table.FillDown(#"Added Conditional Column",{"Filter"}),
    #"Filtered Rows" = Table.SelectRows(#"Filled Down", each ([Column2] <> null)),
    #"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Column2"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Removed Columns",{"Filter", "Column1"}),
    #"Grouped Rows" = Table.Group(#"Reordered Columns", {"Filter"}, {{"TestTable", each _, type table [Filter=text, Column1=nullable text]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.Column([TestTable],"Column1")),
    #"Removed Columns1" = Table.RemoveColumns(#"Added Custom",{"TestTable"}),
    #"Extracted Values" = Table.TransformColumns(#"Removed Columns1", {"Custom", each Text.Combine(List.Transform(_, Text.From), ":"), type text}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Extracted Values", "Custom", Splitter.SplitTextByDelimiter(":", QuoteStyle.Csv), {"Custom.1", "Custom.2", "Custom.3", "Custom.4"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Custom.1", type text}, {"Custom.2", type text}, {"Custom.3", type text}, {"Custom.4", type text}})
in
    #"Changed Type1"
 
Upvote 0
Result with the additional code activated...
Hi Steven the code is perfect........ thanks a ton you are a gem, thanks a lot,

only think i am getting the results as this, how to get result with additional code.



1701883884561.png
 

Attachments

  • 1701884004901.png
    1701884004901.png
    18.8 KB · Views: 5
Upvote 0
Other option with power query
SKU Customer Master - PS--15-06-2023 (002).xls
ABCDE
1FilterCustom.1Custom.2Custom.3Custom.4
2Bundle-Ether10 Gi101/0/0/4 Local Configured 0x8000 Gi102/0/0/4 Local Active 0x8000
3Bundle-Ether20 Gi100/0/0/5 Local Configured 0x8000 Gi101/0/0/5 Local Configured 0x8000
4Bundle-Ether1001 Te0/2/0/28 Local Active 0x8000 Te0/2/0/29 Local Active 0x8000 Te0/3/0/28 Local Active 0x8000 Te0/3/0/29 Local Active 0x8000
5Bundle-Ether1002 Te0/2/0/38 Local Active 0x8000 Te0/2/0/39 Local Active 0x8000 Te0/3/0/38 Local Active 0x8000 Te0/3/0/39 Local Active 0x8000
Table1


Here is the code
Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}}),
    #"Added Conditional Column" = Table.AddColumn(#"Changed Type", "Filter", each if [Column2] = null then [Column1] else null),
    #"Filled Down" = Table.FillDown(#"Added Conditional Column",{"Filter"}),
    #"Filtered Rows" = Table.SelectRows(#"Filled Down", each ([Column2] <> null)),
    #"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Column2"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Removed Columns",{"Filter", "Column1"}),
    #"Grouped Rows" = Table.Group(#"Reordered Columns", {"Filter"}, {{"TestTable", each _, type table [Filter=text, Column1=nullable text]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.Column([TestTable],"Column1")),
    #"Removed Columns1" = Table.RemoveColumns(#"Added Custom",{"TestTable"}),
    #"Extracted Values" = Table.TransformColumns(#"Removed Columns1", {"Custom", each Text.Combine(List.Transform(_, Text.From), ":"), type text}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Extracted Values", "Custom", Splitter.SplitTextByDelimiter(":", QuoteStyle.Csv), {"Custom.1", "Custom.2", "Custom.3", "Custom.4"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Custom.1", type text}, {"Custom.2", type text}, {"Custom.3", type text}, {"Custom.4", type text}})
in
    #"Changed Type1"
Hi Kerryx, thanks a lot of your valuable input, but been honest I am not use to Power Querys
 
Upvote 0
Hi Steven the code is perfect........ thanks a ton you are a gem, thanks a lot,

only think i am getting the results as this, how to get result with additional code.



View attachment 103065
(y)

Change it so the code looks like the below...

VBA Code:
        '>>> Remove the ' from the below to clear the cells as it goes
        'i.ClearContents
        '>>> Below will clear the 0x0000 100000 data
        'i.Offset(0, 1).ClearContents

Just neeeds to have the ' added in front of i.clearcontents and infront of i.Offset. Adding in the little ' will mean it is skipped when running.
 
Upvote 0
This is the code i am using it as you gave not sure as what wrong am i doing, but getting the same result

more over can it be modofied to get the result on colum E as Gi101/0/0/4 on column F as Gi102/0/0/4

don't need the entire think link Gi101/0/0/4 Local Configured 0x8000 but only Gi101/0/0/4



VBA Code:
Sub CopperBENITAgg()

Dim MatchRow As Integer
Dim MoveOffset As Integer
Dim ColLetter As String
Dim Frow As Integer
Dim Lrow As Integer

Frow = 3        '<<< Change this number depending on the row your data starts in
ColLetter = "E" '<<< Change this letter to the column you want to start adding the data in to

Lrow = Range("B" & Frow).End(xlDown).Row 'sets the last row in the data assuming there are no gaps in the data
MoveOffset = 0

For Each i In Range("B" & Frow & ":B" & Lrow)
    If i.Value Like "Bundle*" Then
    MatchRow = i.Row
    MoveOffset = 0
    Else
        Range(ColLetter & MatchRow).Offset(0, MoveOffset).Value = i.Value
        MoveOffset = MoveOffset + 1
        '>>> Remove the ' from the below to clear the cells as it goes
        'i.ClearContents
        '>>> Below will clear the 0x0000 100000 data
        'i.Offset(0, 1).ClearContents

    End If
Next i

End Sub
it is not clearing row 4 & 5 as well.
1701886498159.png
 
Upvote 0
Can you add an image of how you want it to look and in what columns and I'll adapt the code?
 
Upvote 0
Can you add an image of how you want it to look and in what columns and I'll adapt the code?
here you go, then clear the rows 4,5 & 7,8, & 10 and so on.

Book1
ABCDEFGH
1
2
3Bundle-Ether10Gi101/0/0/4Gi102/0/0/4
4 Gi101/0/0/4 Local Configured 0x8000 0x0000 1000000
5 Gi102/0/0/4 Local Active 0x8000 0x0000 1000000
6Bundle-Ether20Gi100/0/0/5 Gi101/0/0/5
7 Gi100/0/0/5 Local Configured 0x8000 0x0000 1000000
8 Gi101/0/0/5 Local Configured 0x8000 0x0000 1000000
9Bundle-Ether40Gi101/0/0/13
10 Gi101/0/0/13 Local Active 0x8000 0x0000 1000000
11Bundle-Ether50Te0/2/0/3Te0/3/0/3
12 Te0/2/0/3 Local Active 0x8000 0x000c 10000000
13 Te0/3/0/3 Local Active 0x8000 0x000e 10000000
14Bundle-Ether70Gi100/0/0/19Gi102/0/0/18
15 Gi100/0/0/19 Local Active 0x8000 0x0004 1000000
16 Gi102/0/0/18 Local Active 0x8000 0x0003 1000000
17Bundle-Ether80Te0/2/0/2Te0/3/0/2
18 Te0/2/0/2 Local Active 0x8000 0x000b 10000000
19 Te0/3/0/2 Local Active 0x8000 0x000d 10000000
20Bundle-Ether1000Te0/2/0/18Te0/2/0/19Te0/3/0/18Te0/3/0/19
21 Te0/2/0/18 Local Active 0x8000 0x0000 10000000
22 Te0/2/0/19 Local Active 0x8000 0x0000 10000000
23 Te0/3/0/18 Local Active 0x8000 0x0000 10000000
24 Te0/3/0/19 Local Active 0x8000 0x0000 10000000
25Bundle-Ether1001Te0/2/0/28Te0/2/0/29Te0/3/0/28Te0/3/0/29
26 Te0/2/0/28 Local Active 0x8000 0x0000 10000000
27 Te0/2/0/29 Local Active 0x8000 0x0000 10000000
28 Te0/3/0/28 Local Active 0x8000 0x0000 10000000
29 Te0/3/0/29 Local Active 0x8000 0x0000 10000000
30
31
Sheet1
 
Upvote 0
OK, so clear the rows (cell contents are deleted) and just show the first part of the cells contents when moved...

VBA Code:
Sub MoveStuff()

Dim MatchRow As Integer
Dim MoveOffset As Integer
Dim ColLetter As String
Dim CelText As String
Dim Frow As Integer
Dim Lrow As Integer
Dim n As Long

Frow = 3        '<<< Change this number depending on the row your data starts in
ColLetter = "E" '<<< Change this letter to the column you want to start adding the data in to

Lrow = Range("B" & Frow).End(xlDown).Row 'sets the last row in the data assuming there are no gaps in the data
MoveOffset = 0

For Each i In Range("B" & Frow & ":B" & Lrow)
    If i.Value Like "Bundle*" Then
    MatchRow = i.Row
    MoveOffset = 0
    Else
        CelText = i.Value
        n = InStr(CelText, " ") - 1
        Range(ColLetter & MatchRow).Offset(0, MoveOffset).Value = Left(CelText, n)
        MoveOffset = MoveOffset + 1
        i.Resize(1, 2).ClearContents
    End If
Next i

End Sub

Just so you know it looks for the first " " [space] in the text and then trims it to that point.

Gets me this when I run it...
1701939258963.png
 
Upvote 0

Forum statistics

Threads
1,223,712
Messages
6,174,031
Members
452,542
Latest member
Bricklin

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