• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Merged cell Split into Rows.

Monty

Monty

Well-Known Member
Hello experts,

Attached Excel for reference

Please help me to split the Merged cell into rows dynamically and autofill the rest of the columns. Currently holding 3000 line items. Attached file contains sample of 2 rows

SCREENSHORT.png
 

Attachments

  • Test.xlsb
    8.6 KB · Views: 8


I have tried building the following Code and still under Testing
Code: 
Sub SplitIPAddresses()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim LastRow As Long
    Dim i As Long
    Dim j As Long
    Dim ipArray() As String
    Dim r As Range
    Dim numRows As Integer

    ' Disable screen updating to speed up the macro
    Application.ScreenUpdating = False

    ' Find the last row with data
    LastRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row ' Change "L" to the appropriate column letter for column 12

    ' Start from the bottom row to avoid overwriting data as we will be inserting rows
    For i = LastRow To 2 Step -1 ' Assumes headers are in row 1
        ' Assumes IP Addresses are in column 12 and separated by line breaks
        ipArray = Split(Replace(ws.Cells(i, 12).Value, Chr(10), " "), " ") ' Change "12" to the appropriate column number

        ' Check if there is more than one IP address to split
        If UBound(ipArray) > 0 Then
            ' Calculate number of additional rows needed
            numRows = UBound(ipArray)

            ' Insert new rows for additional IP addresses
            ws.Rows(i + 1 & ":" & i + numRows).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            ' Set IP Address for new rows and copy data from original row
            For j = 0 To numRows
                ws.Cells(i + j, 12).Value = Trim(ipArray(j)) ' Assign each IP address, change "12" to the appropriate column number
                ' Copy data from the original row to the new rows
                ws.Cells(i + j, 1).Resize(, 11).Value = ws.Cells(i, 1).Resize(, 11).Value ' Change "11" to the appropriate number of columns to copy
                ws.Cells(i + j, 13).Value = ws.Cells(i, 13).Value ' Change "13" to the appropriate column number to copy
            Next j

            LastRow = LastRow + numRows ' Update the last row number
        End If
    Next i

    ' Enable screen updating once done
    Application.ScreenUpdating = True

    MsgBox "Split of IP Addresses into rows completed."
End Sub



Code: 
Sub FillBlanksAboveDynamic()
    Dim startRow As Long
    Dim rng As Range
    Dim blankCells As Range

    ' Set the starting row dynamically
    startRow = 3 ' You can change this to the desired starting row

    ' Set the range to the desired column or range dynamically based on the last used row in column H
    Set rng = Range("H" & startRow & ":H" & Cells(Rows.Count, "H").End(xlUp).Row)

    ' Find blank cells in the specified range
    On Error Resume Next
    Set blankCells = rng.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    ' Check if blank cells were found
    If Not blankCells Is Nothing Then
        ' Fill blanks with the value from one cell above
        blankCells.FormulaR1C1 = "=R[-1]C"
    Else
        MsgBox "No blank cells found in the specified range.", vbInformation
    End If
End Sub
 
Last edited:
With Power Query

Code: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"IP Address", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "IP Address")
in
    #"Split Column by Delimiter"
 

Attachments

  • Test.xlsb
    16.2 KB · Views: 3
Hello, according to Excel basics a beginner level VBA demonstration for starters :​
Code: 
Sub Demo1()
    Dim R&, S$()
   With [A1].CurrentRegion.Rows
    For R = .Count To 2 Step -1
        S = Split(.Cells(R, 5), vbLf)
     If UBound(S) > 0 Then
       .Item(R + 1).Resize(UBound(S)).Insert
       .Item(R).Copy .Item(R + 1).Resize(UBound(S))
       .Cells(R, 5).Resize(UBound(S) + 1) = Application.Transpose(S)
     End If
    Next
   End With
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
Maybe faster with raw data only :​
Code: 
Sub Demo2()
    Dim V, W(), R&, S$(), T&, L&, C%
        V = [A1].CurrentRegion
        ReDim W(1 To Rows.Count - 1, 1 To UBound(V, 2))
    For R = 2 To UBound(V)
        S = Split(V(R, 5), vbLf)
    For T = 0 To UBound(S) + (S(UBound(S)) = "")
        L = L + 1
    For C = 1 To UBound(V, 2)
        W(L, C) = IIf(C = 5, S(T), V(R, C))
    Next C, T, R
        [A2].Resize(L, UBound(W, 2)) = W
End Sub
You may Like it !​
 
H
Marc L said:
Maybe faster with raw data only :​
Code: 
Sub Demo2()
    Dim V, W(), R&, S$(), T&, L&, C%
        V = [A1].CurrentRegion
        ReDim W(1 To Rows.Count - 1, 1 To UBound(V, 2))
    For R = 2 To UBound(V)
        S = Split(V(R, 5), vbLf)
    For T = 0 To UBound(S) + (S(UBound(S)) = "")
        L = L + 1
    For C = 1 To UBound(V, 2)
        W(L, C) = IIf(C = 5, S(T), V(R, C))
    Next C, T, R
        [A2].Resize(L, UBound(W, 2)) = W
End Sub
You may Like it !​
Click to expand...
Hello Marc
it works and faster am atill wonder after splitting 5thbcolumn in into rows rest of the columns should be auto filled.....so rhat entire data should look like perfectly as table with no nulls
 
AlanSidman said:
With Power Query

Code: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"IP Address", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "IP Address")
in
    #"Split Column by Delimiter"
Click to expand...
Hello Alan

Thank you so very much for the power query solution, Though i do not prefer to use as got use to VBA very much.

But having seen these few lines written by you....Amazing it works blink of the eye.

Please help me in case if we need to mention file path rather then current workbook.

Source =Excel.Workbook
Click to expand...



Your help is much appreciated.
 
Monty said:
Hello Alan

Thank you so very much for the power query solution, Though i do not prefer to use as got use to VBA very much.

But having seen these few lines written by you....Amazing it works blink of the eye.

Please help me in case if we need to mention file path rather then current workbook.





Your help is much appreciated.
Click to expand...
 
Code: 
Sub Addresses()
    Dim newHostReport As Worksheet
    Dim sourceReport As Worksheet
    Dim newHostRange As Range
    Dim sourceRange As Range
    Dim newHostCell As Range
    Dim sourceCell As Range
    Dim ipAddress As String
    Dim matchFound As Boolean
    
    Set newHostReport = ThisWorkbook.Worksheets("NEWHOST REPORT")
    Set sourceReport = ThisWorkbook.Worksheets("SOURCE REPORT")
    Set newHostRange = newHostReport.Range("L2:L" & newHostReport.Cells(Rows.Count, "L").End(xlUp).Row)
    Set sourceRange = sourceReport.Range("A2:A" & sourceReport.Cells(Rows.Count, "A").End(xlUp).Row)
    
    For Each newHostCell In newHostRange
        ipAddress = newHostCell.Value
        matchFound = False
        
        For Each sourceCell In sourceRange
            If sourceCell.Value = ipAddress Then
                matchFound = True
                Exit For
            End If
        Next sourceCell
        
        If matchFound Then
            newHostCell.Offset(0, 1).Value = "Yes"
        Else
            newHostCell.Offset(0, 1).Value = "No"
        End If
    Next newHostCell
End Sub
 
No idea what your previous post code states for - as no link with your initial post neither your attachment, guessing can't be coding ! -​
but your code is exactly the VBA school sample to what to not do ‼ Useless variables for never changing values, useless loops …​
​
According to Excel basics, like an Excel beginner can achieve with a worksheet formula,​
using under VBA the same formula can replace all your code, the result processed at once with an unique statement !​
​
 
You must log in or register to reply here.
Back
Top