New to VBA - split cell with no clear delineation RRS feed

  • Question

  • The easy answer to my problem is to correct the method with which my company identifies hydraulic hoses but alas...

    Our P/N has no delineation of spaces, /, -, etc.


    components are actually items like: A33-xxx, BB11, CC22, if 11=/=33, BB11-33., if 22=/=33, CC22-33

    The first step for creating my actual parts is to find out which a, bb, cc, etc I have.

    What I'm attempting to do is output the components of each hydraulic hose in an assembly to its base parts.  There are 120+ hoses in our largest assemblies.  I'm new to VBA, normally I'd just use formulas or conditional formatting.... I'm running out of resources because of the # of components.

    My current attempt (I'll post code after I'm verified):

    • Defined workbook and sheet
    • Dim variants for each of my base components + sizing (7)
    • Dim and set range ("C:C")
    • Format range as text
    • Created a loop to search for the next (2) empty cells before stopping.  Within the loop:
    • Do until isempty(activecell) and isempty(activecell.offset(1,0))
    • Identified each cell in my range as a string
    • Using Left and Mid I've pulled components out of my string and defined my variants (IE Dim HoseType as variant; HoseType=Left(Hose,1)), where Hose=activecell.value
    • Create array where hosear=vba.array(hosetype, hosesize, etc)
    • I'm attempting to write the array starting in column 7 (G) with (1,Ubound(HoseAR)).

    I get blank cells.  F8 finds no error in the code but I feel I'm either missing a step or using a more complicated solution than is available.

    When I get authenticated I will post the code.

    Suggestions on a simpler solution welcome.

    Private Sub CommandButton4_Click()
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = ActiveWorkbook.Sheets("Hose List")
    Dim HoseType As Variant
    Dim HoseSize As Variant
    Dim HoseLength As Variant
    Dim HoseEnd1 As Variant
    Dim End1Size As Variant
    Dim HoseEnd2 As Variant
    Dim End2Size As Variant
    Worksheets("Hose List").Columns(3).NumberFormat = "@"
    Dim PartNumber As Range
    On Error Resume Next
    Set PartNumber = Range("C:C")
    Application.ScreenUpdating = False
    Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
        For Each cell In PartNumber
        Dim Hose As String
        'Dim HoseAR() As Long
        Dim HoseAR() As Variant
        Hose = ActiveCell.Value
        HoseType = Left(Hose, 1)
        HoseSize = Mid(Hose, 10, 2)
        HoseLength = Mid(Hose, 12, 3)
        HoseEnd1 = Mid(Hose, 2, 2)
        End1Size = Mid(Hose, 6, 2)
        HoseEnd2 = Mid(Hose, 4, 2)
        End2Size = Mid(Hose, 8, 2)
        HoseAR = VBA.Array(HoseType, HoseSize, HoseLength, HoseEnd1, End1Size, HoseEnd2, End2Size)
        Dim Destination As Range
        Set Destination = Range("G:G")
        Set Destination = Destination.Resize(1, UBound(HoseAR))
        Next cell
    ActiveCell.Offset(2, 0).Select
    Application.ScreenUpdating = False
    End Sub

    • Edited by ALovegren Thursday, November 29, 2018 5:57 PM
    Thursday, November 29, 2018 5:10 PM

All replies

  • I have looked at this question several times and I still don't really understand what you require. I have been waiting to see if someone else understands but as you do not have an answer, I thought that I should ask for more information and then see if I can help.

    Can you upload a copy of the workbook with the source data and then indicate what you expect as the output data.

    Also, I don't understand the rules to be applied to get the following from the example source data you supplied.

    components are actually items like: A33-xxx, BB11, CC22, if 11=/=33, BB11-33., if 22=/=33, CC22-33

    In particular, what does if 11=/=33 and if 22=/=33 mean?

    Guidelines to upload a workbook on OneDrive. (If you already use OneDrive and your process for saving to it is different then you can probably start at step 8 to get the link but please zip the file before uploading.)

    1. Zip your workbooks. Do not just save an unzipped workbook to OneDrive because the workbooks open with On-Line Excel and the limited functionality with the On-Line version causes problems.
    2. To Zip a file: In Windows Explorer Right click on the selected file and select Send to -> Compressed (zipped) folder). By holding the Ctrl key and left click once on each file, you can select multiple workbooks before right clicking over one of the selections to send to a compressed file and they will all be included into the one Zip file.
    3. Do not use 3rd party compression applications because I cannot unzip them. I do not clog up my computer with 3rd party apps when there are perfectly good apps supplied with windows.
    4. Go to this link.
    5. Use the same login Id and Password that you use for this forum.
    6. Select Upload in the blue bar across the top and browse to the zipped folder to be uploaded.
    7. Select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
    8. Right click the file on OneDrive and select Share.
    9. Select "Get a Link" from the popup menu.
    10. Click in the field displaying the link and Ctrl and A should highlight the entire link and then Copy and Paste the link into your reply on this forum. (I suggest that you avoid the "Copy" button on the "Get a link" screen because it introduces additional steps that are not required.)

    Regards, OssieMac

    Monday, December 3, 2018 2:55 AM
  • Thanks for the reply, clarity is always the first concern.

    file link:!Ao1OXLyhw-aDhKgvFKEJ83f-3yyQ4w

    Attached is (will be) an image of our part number.

    For now the part number rules can be ignored.  I'm just curious how I can split Column C based on the A, B, C, etc designation in the image attached.  I updated the zipped excel sheet on rows 5 and 15 for what outcome I'm trying to get out of building and writing the array based on column C.

    Our actual part numbers aren't smart.  In the spreadsheet if [Column H]=[Column K] the product would produce a part number built with [Column J][Column K].  If [Column H] is not equal to (=/=) [Column K] then the product would be [Column J][Column K]-[Column H].

    In row 5 of the attached sheet the first hose end would be JS08 because [Column H]=[Column K], second hose end JS08 because [Column H]=[Column M]

    In row 15 of the attached sheet the first hose end would be JS15-12 because [Column H]=/=[Column K], second hose end J912 because [Column H]=[Column M].

    The end goal is to build a table of all hose ends for our buyer with quantities.  That will require first looking at column C and verifying the part number meets criteria based on vlookup where N has 4 possible values, B has 12 possible values, D-F have 7 possible values. Then setting rules to build the part numbers where columns H, K, and M are compared.

    If resources weren't an issue that would be easy with formulas in the cells where I want everything written.

    • Edited by ALovegren Monday, December 3, 2018 5:07 PM
    Monday, December 3, 2018 5:05 PM
  • Cannot use ActiveCell on a worksheet that is not the Active Worksheet. (The code will reference the ActiveCell on the ActiveSheet).

    Do not change the ActiveSheet with VBA code when the code is in a module that belongs to a worksheet. The code becomes confused about which is the ActiveSheet. Simply fully reference the other worksheet and range etc. In fact, it is almost never necessary to use ActiveSheet and ActiveCell.

    Rather than upload an edited workbook, here is all of your code in the "Fitting Table" Module. Delete all of your code in this module and replace with the following.

    Private Sub CommandButton1_Click()
        Cells(1, 1) = "Hello"
    End Sub
    Private Sub CommandButton3_Click()
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = ActiveWorkbook.Sheets("Hose List")
    Dim header() As Variant
    With ws
        'Loop not required. Just resize a single cell to same size an array and make its values equal to array values.
        'For i = LBound(header()) To UBound(header())
        .Cells(1, "A").Resize(1, UBound(header()) + 1).Value = header()     'Ubound +1 because of zero based array
        'Next i
    End With
    End Sub
    Private Sub CommandButton4_Click()
    Dim wb As Workbook
    Dim wsHoseLst As Worksheet  'Use a name that is identifiable with the worksheet
    Dim PartNumber As Range
    Dim Hose As String
    Dim rCell As Range      'Cell is a reserved word so best to use rCell (RangeCell)
    Dim rDestin As Range  'This variable changed because Destination is a reserved word in VBA
    Set wb = ActiveWorkbook
    'Set wsHoseLst = ActiveWorkbook.Sheets("Hose List")
    Set wsHoseLst = wb.Sheets("Hose List")  'Use the variable that has the ActiveWorkbook assigned to it.
    Dim HoseType As String
    Dim HoseSize As String
    Dim HoseLength As String
    Dim HoseEnd1 As String
    Dim End1Size As String
    Dim HoseEnd2 As String
    Dim End2Size As String
    Worksheets("Hose List").Columns(3).NumberFormat = "@"
    Worksheets("Hose List").Columns("G:M").NumberFormat = "@"   'Output columns
    'On Error Resume Next   'Not required so best not to use this
    With wsHoseLst
        'Following line commences at row 4 because rows 2 and 3 are "FACTORY" and don't meet the array requirements
        'Edit the 4 in .Cells(4, "C") if you want it to commence from a different row.
        Set PartNumber = .Range(.Cells(4, "C"), .Cells(.Rows.Count, "C").End(xlUp)) 'From Row 4 to last populated cell
    End With
    Application.ScreenUpdating = False
    'Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))      'Not required
        For Each rCell In PartNumber
            Dim HoseAR() As Variant
            Hose = rCell.Value
            HoseType = Left(Hose, 1)
            HoseSize = Mid(Hose, 10, 2)
            HoseLength = Mid(Hose, 12, 3)
            HoseEnd1 = Mid(Hose, 2, 2)
            End1Size = Mid(Hose, 6, 2)
            HoseEnd2 = Mid(Hose, 4, 2)
            End2Size = Mid(Hose, 8, 2)
            HoseAR() = Array(HoseType, HoseSize, HoseLength, HoseEnd1, End1Size, HoseEnd2, End2Size)
            Set rDestin = rCell.Offset(0, 4)    'Initialize rDestin to column G (Offset 4 columns from column C)
            Set rDestin = rDestin.Resize(1, UBound(HoseAR) + 1) 'Need Plus 1 for zero based array
            rDestin.Value = HoseAR()
        Next rCell
    'ActiveCell.Offset(2, 0).Select 'Not required and can only use ActiveCell on the ActiveSheet.
    'Loop       'Not required
    Application.ScreenUpdating = False
    End Sub

    Regards, OssieMac

    Monday, December 3, 2018 11:37 PM