Excel indenting workaround

[SP2018]

Hello all,

First post hope someone can help with this.

On Excel, I have about a list of about 2000 rows. With parent fields and then a child field below it - all on one column. Not all parent fields have a child field. But all child fields are indented to one - these are all indented to "7" and not spaced. I need to try and copy all child fields to a separate sheet. e.g.

[COLOR=#45453F][FONT=Helvetica]Europe (parent field)[/FONT][/COLOR]
[COLOR=#45453F][FONT=Helvetica]     UK (child field)[/FONT][/COLOR]
[COLOR=#45453F][FONT=Helvetica]     France (child field)[/FONT][/COLOR]
[COLOR=#45453F][FONT=Helvetica]     Germany (child field)[/FONT][/COLOR]
[COLOR=#45453F][FONT=Helvetica]Asia (parent field)[/FONT][/COLOR]
[COLOR=#45453F][FONT=Helvetica]Africa (parent field)[/FONT][/COLOR]
[COLOR=#45453F][FONT=Helvetica]    Nigeria (child field)[/FONT][/COLOR]

So, looking to cut and paste all child fields to another sheet and leave just parent fields on the primary sheet. I have tried "text to column" but didnt work as the indented (child fields) were not spaced but indented.

So any formula that would ideally count the starting point of the cell...or similar.

Many thanks,

 

[VBA Geek]

Hello. I do not get the indented to 7 part. can you post a better sample maybe?

you can use html maker: https://www.mrexcel.com/forum/excel-questions/628649-recommended-add-ins-links.html

 

[SP2018]

Hi VBA Geek, thanks for your response.

I don't know how to attach a screenshot.

When I right-hand click on a cell > format cells > Alignment > Indent

All parent fields indent = 5
All child fields indent = 7

So, I need to somehow cut and paste all child fields to another sheet. A lot harder with over 2000 rows.

Europe (parent field)
UK (child field)
France (child field)
Germany (child field)
Asia (parent field)
Africa (parent field)
Nigeria (child field)

 

[VBA Geek]

Hi VBA Geek, thanks for your response.

I don't know how to attach a screenshot.

When I right-hand click on a cell > format cells > Alignment > Indent

All parent fields indent = 5
All child fields indent = 7

So, I need to somehow cut and paste all child fields to another sheet. A lot harder with over 2000 rows.

Europe (parent field)
UK (child field)
France (child field)
Germany (child field)
Asia (parent field)
Africa (parent field)
Nigeria (child field)

try this small macro

Sub copyIndent()
Dim xlRng As Excel.Range, xlRngs As Excel.Range, vArr As Variant, iLoop As Long

Set xlRng = Application.InputBox("Please select your source data", , , , , , , 8)

ReDim vArr(1 To 1000)
iLoop = 0

For Each xlRngs In xlRng.Cells
    If xlRngs.IndentLevel = [COLOR=#ff0000][B]7[/B][/COLOR] Then
        iLoop = iLoop + 1
        If iLoop > UBound(vArr) Then ReDim Preserve vArr(1 To UBound(vArr) + 1000)
        vArr(iLoop) = xlRngs.Value
    End If
Next xlRngs
If iLoop < UBound(vArr) Then ReDim Preserve vArr(1 To iLoop)
Application.InputBox("Please select destination Cell", , , , , , , 8).Cells(1, 1).Resize(iLoop).Value = Application.Transpose(vArr)
End Sub

 

[SP2018]

Many many thanks VBA Geek!!! You've saved me a lot of manual effort as one sheet was with 2000 rows but I have about 15 of these! Helped a lot - many thanks once again

 

[Rick Rothstein]

Many many thanks VBA Geek!!! You've saved me a lot of manual effort as one sheet was with 2000 rows but I have about 15 of these! Helped a lot - many thanks once again

In case you might be interested, and assuming the parent cells' HorizontalAlignment is set to General, not Left(Indent), then you can do this without using a loop also...

[table="width: 500"]
[tr]
	[td]Sub GetChildFields()
  Dim RngIn As Range, RngOut As Range
  On Error GoTo Whoops
  Set RngIn = Application.InputBox("Please select your source data...", Type:=8)
  Set RngOut = Application.InputBox("Please select your destination cell...", Type:=8)
  Application.FindFormat.Clear
  Application.FindFormat.HorizontalAlignment = 1
  Application.ScreenUpdating = False
  RngIn.Copy RngOut(1)
  With RngOut.Resize(RngIn.Rows.Count)
    .Replace "*", "", SearchFormat:=True, ReplaceFormat:=False
    .SpecialCells(xlBlanks).Delete xlShiftUp
    .IndentLevel = 0
  End With
  Application.FindFormat.Clear
Whoops:
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]