PDA

View Full Version : Trim rows in multiple sheets



fatalcore
04-27-2020, 07:37 PM
Hi Friends

Can someone please help me with a VBA code. I have three to four tabs each containing approx 20-35 rows of this data


{ "user" : "DC=Certificate Manager,O=Test Inc.,OU=QA:dc.group.1339956,CN=vid,UID=identity:dc.group.1359009", "roles" : [ { "role" : "QA", "db" : "admin" }, { "role" : "Test", "db" : "admin" }, { "role" : "ADMIN", "db" : "admin" } ] }


Can somebody help me out with a vba code to trim the above line to this


{ "user" : "DC=Certificate Manager,O=Test Inc.,OU=QA:dc.group.1339956,CN=vid,UID=identity:dc.group.1359009" }

Currently I am manually doing this, I am searching ", "roles" : " and manually replacing with " }%", then doing a text to column, applying delimiter as % . I tried recording a macro and my excel crashed I will really appreciate if someone can help me.

Thanks,

Paul_Hossler
04-27-2020, 08:14 PM
Try this



Option Explicit


Sub test()
Dim ws As Worksheet
Dim r As Range, c As Range
Dim n As Long

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
Set r = Nothing
On Error Resume Next
Set r = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

If Not r Is Nothing Then
For Each c In r.Cells
n = InStr(c.Value, ", ""roles""")
If n > 0 Then c.Value = Left(c.Value, n - 1) & "}"
Next
End If
Next


Application.ScreenUpdating = False


MsgBox "Done"
End Sub

fatalcore
04-27-2020, 09:23 PM
Try this



Option Explicit


Sub test()
Dim ws As Worksheet
Dim r As Range, c As Range
Dim n As Long

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
Set r = Nothing
On Error Resume Next
Set r = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

If Not r Is Nothing Then
For Each c In r.Cells
n = InStr(c.Value, ", ""roles""")
If n > 0 Then c.Value = Left(c.Value, n - 1) & "}"
Next
End If
Next


Application.ScreenUpdating = False


MsgBox "Done"
End Sub





Thank you so much