Left function in VBA

Question

I have an output file being generated via power-shell that provides a dump of shares and there permissions in the following format:

I am looking to code out in VBA a module where I can drop the raw data in a sheet called Input and fun the marco so the output looks as follows:

I ma very new to VBA but altering some code provided my the Stackoverflow community I have got this far:

Sub PathAccessSplit()

Dim wsFrom, wsTo As Worksheet
Dim rowFrom, rowTo, lastRow As Long
Dim cellVal As String

Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")

lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
rowTo = 1

For rowFrom = 1 To lastRow
cellVal = wsFrom.Cells(rowFrom, 1).Text

If (Left(cellVal, 4) = "Name") Then
  wsTo.Cells(rowTo, 1).Value = cellVal
ElseIf (Left(cellVal, 8) = "FullName") Then
  wsTo.Cells(rowTo, 2).Value = cellVal
ElseIf (Left(cellVal, 18) = "InheritanceEnabled") Then
  wsTo.Cells(rowTo, 3).Value = cellVal
ElseIf (Left(cellVal, 13) = "InheritedFrom") Then
  wsTo.Cells(rowTo, 4).Value = cellVal
ElseIf (Left(cellVal, 17) = "AccessControlType") Then
  wsTo.Cells(rowTo, 5).Value = cellVal
ElseIf (Left(cellVal, 12) = "AccessRights") Then
  wsTo.Cells(rowTo, 6).Value = cellVal
ElseIf (Left(cellVal, 7) = "Account") Then
  wsTo.Cells(rowTo, 7).Value = cellVal
ElseIf (Left(cellVal, 16) = "InheritanceFlags") Then
  wsTo.Cells(rowTo, 8).Value = cellVal
ElseIf (Left(cellVal, 11) = "IsInherited") Then
  wsTo.Cells(rowTo, 9).Value = cellVal
ElseIf (Left(cellVal, 16) = "PropagationFlags") Then
  wsTo.Cells(rowTo, 10).Value = cellVal
ElseIf (Left(cellVal, 11) = "AccountType") Then
  wsTo.Cells(rowTo, 11).Value = cellVal

  rowTo = rowTo + 1
End If

But the output is just transposing the output, and only outputting one set of results, not moving on 2 the second set of permissions.

I need the VBA to be robust enough to handle 1000+ sets of outputs.

Any help would be greatly appreciated

Wayne

Answer 1

The question has been answered, but after lunch I thinking: if really the block can be thousand, why don't use one array, I testing it with 300 block ad it's very fast.

Sub wsfrom_Pulsante2_Click()
Dim wsFrom  As Worksheet, wsTo As Worksheet
Dim lastRow As Long
Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")
lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
lastBlock = Round((lastRow + 1) / 12, 0)    'to count how many block (11 item + 1 blanck row) are in the range

Dim arr As Variant
ReDim arr(1 To lastBlock, 1 To 11)          'redim 1th diemnsion array to exactly no off block
i = 1
For x = 1 To lastBlock
        For y = 1 To 11
            arr(x, y) = Mid(Cells(i, 1), (InStr(Cells(i, 1), ":") + 1))
            i = i + 1
        Next y
        i = i + 1                           'add one to jump blanck row
Next x
wsTo.Range("A2:K" & lastBlock) = arr        'put the value on defined sheet
End Sub

Answer 2

Here's TextToColumn as well, then Used rangeAreas to copy and paste

   Sub Button1_Click()
    Dim RangeArea As Range
    Dim ws As Worksheet, sh As Worksheet

    Set ws = Sheets("Input")
    Set sh = Sheets("Output")

    Application.DisplayAlerts = 0
    Application.ScreenUpdating = 0

    With ws

        .Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                      Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                                                                                                 :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

        .Range(.Range("A1"), .Range("A1").End(xlDown)).Copy
        sh.Range("A1").PasteSpecial xlPasteValues, Transpose:=True

        For Each RangeArea In .Columns("A").SpecialCells(xlCellTypeConstants, 23).Areas

            RangeArea.Offset(, 1).Copy
            sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True

        Next RangeArea

    End With

    Application.CutCopyMode = 0
End Sub

Answer 3

rather than using all of those "if, then" I would use a select case, this is another way.

Sub wsfrom_Pulsante1_Click()
Dim wsFrom  As Worksheet, wsTo As Worksheet             'otherwise the first is a variable
Dim rowFrom As Long, rowTo As Long, lastRow As Long
Dim cellVal As String
Set wsFrom = Sheets("Input")
Set wsTo = Sheets("Output")
lastRow = wsFrom.Cells(wsFrom.Rows.Count, "A").End(xlUp).Row
rowTo = 1
For rowFrom = 1 To lastRow
cellVal = wsFrom.Cells(rowFrom, 1).text
If cellVal = "" Then    'the blanck row between one block to another
    rowTo = rowTo + 1   'ad 1 for the next row in wsTo
End If
On Error Resume Next    'jump the error Left(cellVal, InStr(cellVal, " ") - 1) because the cell is ""
Select Case Left(cellVal, InStr(cellVal, " ") - 1)
    Case "Name"
        wsTo.Cells(rowTo, 1).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "FullName"
        wsTo.Cells(rowTo, 2).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritanceEnabled"
        wsTo.Cells(rowTo, 3).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritedFrom"
        wsTo.Cells(rowTo, 4).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccessControlType"
        wsTo.Cells(rowTo, 5).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccessRights"
        wsTo.Cells(rowTo, 6).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "Account"
        wsTo.Cells(rowTo, 7).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "InheritanceFlags"
        wsTo.Cells(rowTo, 8).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "IsInherited"
        wsTo.Cells(rowTo, 9).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "PropagationFlags"
        wsTo.Cells(rowTo, 10).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
    Case "AccountType"
        wsTo.Cells(rowTo, 11).Value = Mid(cellVal, (InStr(cellVal, ":") + 1))
End Select
Next rowFrom
End Sub

Answer 4

The Range.TextToColumns method can get started on the split and trimming of the cell information. Bulk operations are almost always faster than looping and are often offer better error control. Once split and trimmed, looping through a variant array into a Select Case statement should transpose the values into their respective fields. There was no discussion on guaranteed complete record sets so I avoided simply dumping the transposed data back en masse.

Sub PathAccessSplit()
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim v As Long, rwTo As Long, vVALs As Variant

    Set wsFrom = Sheets("Input")
    Set wsTo = Sheets("Output")

    With wsTo
        With .Cells(1, 1).CurrentRegion
            With .Resize(Application.Max(1, .Rows.Count - 1), .Columns.Count).Offset(1, 0)
                .ClearContents
                rwTo = 1
            End With
        End With
    End With

    With wsFrom
        With .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
            With .Columns(1)
                .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
                               ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
                               Comma:=False, Space:=False, Other:=True, OtherChar:=":", _
                               FieldInfo:=Array(Array(1, 1), Array(2, 1))
                .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
                               FieldInfo:=Array(0, 2)
            End With

            vVALs = .Columns("A:B").Value2

        End With
    End With

    With wsTo
        For v = LBound(vVALs, 1) To UBound(vVALs, 1)
            Select Case Trim(LCase(vVALs(v, 1)))
                Case "name"
                    rwTo = rwTo + 1
                    .Cells(rwTo, 1) = vVALs(v, 2)
                Case "fullname"
                    .Cells(rwTo, 2) = vVALs(v, 2)
                Case "inheritanceenabled"
                    .Cells(rwTo, 3) = vVALs(v, 2)
                Case "inheritancefrom"
                    .Cells(rwTo, 4) = vVALs(v, 2)
                Case "accesscontroltype"
                    .Cells(rwTo, 5) = vVALs(v, 2)
                Case "accessrights"
                    .Cells(rwTo, 6) = vVALs(v, 2)
                Case "account"
                    .Cells(rwTo, 7) = vVALs(v, 2)
                Case "inheritanceflags"
                    .Cells(rwTo, 8) = vVALs(v, 2)
                Case "isinherited"
                    .Cells(rwTo, 9) = vVALs(v, 2)
                Case "propagationflags"
                    .Cells(rwTo, 10) = vVALs(v, 2)
                Case "accounttype"
                    .Cells(rwTo, 11) = vVALs(v, 2)
                Case Else
                    'space - do nothing
            End Select
        Next v
    End With

End Sub

This is largely untested due to the fact that I was not going to retype the sample data. If fields are missing they are likely misspelled.

Answer 5

It's to do with your If...Else structure. Because you are using ElseIf, then only one of those statements will actually be run.

You need to change your syntax to use only If statements, like so:

If (Left(cellVal, 4) = "Name") Then
  wsTo.Cells(rowTo, 1).Value = cellVal
End If
If (Left(cellVal, 8) = "FullName") Then
  wsTo.Cells(rowTo, 2).Value = cellVal
End If
If (Left(cellVal, 18) = "InheritanceEnabled") Then
  wsTo.Cells(rowTo, 3).Value = cellVal
End If

etc

In this way, each of the statements will be tested and run (if they pass the clause in the If statement).

To select only the characters after the colon ':', try:

If (Left(cellVal, 4) = "Name") Then 
    wsTo.Cells(rowTo, 1).Value = Right(cellVal, Len(cellVal) - InStr(cellVal, ":") - 1) 
End If