Split Ranges of Reference Designators

[vdevita]

Hello,
I have a worksheet of parts that contains ranges of reference designators, per part, that I would like split into individual reference designators.

For Example, here is a sample of the reference designator ranges:
[TABLE="class: grid, width: 375, align: left"]
<tbody>[TR]
[TD]Part Number
[/TD]
[TD]Description
[/TD]
[TD]Reference Designator
[/TD]
[/TR]
[TR]
[TD]852852
[/TD]
[TD]Resistor
[/TD]
[TD]R1-R4
[/TD]
[/TR]
[TR]
[TD]258258
[/TD]
[TD]Capacitor
[/TD]
[TD]C16-C20
[/TD]
[/TR]
</tbody>[/TABLE]






This is how I would like it split:

[TABLE="class: grid, width: 375"]
<tbody>[TR]
[TD]Part Number
[/TD]
[TD]Description
[/TD]
[TD]Reference Designator
[/TD]
[/TR]
[TR]
[TD]852852
[/TD]
[TD]Resistor
[/TD]
[TD]R1
[/TD]
[/TR]
[TR]
[TD]852852
[/TD]
[TD]Resistor
[/TD]
[TD]R2
[/TD]
[/TR]
[TR]
[TD]852852
[/TD]
[TD]Resistor
[/TD]
[TD]R3
[/TD]
[/TR]
[TR]
[TD]852852
[/TD]
[TD]Resistor
[/TD]
[TD]R4
[/TD]
[/TR]
[TR]
[TD]258258
[/TD]
[TD]Capacitor
[/TD]
[TD]C16
[/TD]
[/TR]
[TR]
[TD]258258
[/TD]
[TD]Capacitor
[/TD]
[TD]C17
[/TD]
[/TR]
[TR]
[TD]258258
[/TD]
[TD]Capacitor
[/TD]
[TD]C18
[/TD]
[/TR]
[TR]
[TD]258258
[/TD]
[TD]Capacitor
[/TD]
[TD]C19
[/TD]
[/TR]
[TR]
[TD]258258
[/TD]
[TD]Capacitor
[/TD]
[TD]C20
[/TD]
[/TR]
</tbody>[/TABLE]

Thanks,
vdevita

 

[kpark91]

Where do you want the result?

and will the reference always start with an alphabet and end with a number?

 

[vdevita]

Code posted in the thread is fine with me.

Yes, the reference designator is always of that format. It will always begin with a letter and end with a number. Though there are a few cases that start with two letters then end with any sequence of numbers (AR101, VR202).

 

[kpark91]

Code posted in the thread is fine with me.

Oops. Looks like I wasn't clear enough.
I meant where should the result for the code go (in the same worksheet? in a different worksheet named "Sheet2"?)

 

[vdevita]

Oh, gotcha. In the same worksheet.

 

[kpark91]

Given that your original data is in column A to C starting from Row 1.

Sub a()
    Dim LR&, i&, startRow&, endRow&, strStart$, strEnd$, intDashPos%, tmp$, j&, strAlpha$
    Dim count&
    LR = Range("C" & Rows.count).End(xlUp).Row
    
    count = 2
    For i = 2 To LR
        intDashPos = InStr(1, Range("C" & i).Value, "-", vbBinaryCompare)
        If intDashPos Then
            strStart = Left(Range("C" & i).Value, intDashPos - 1)
            strEnd = Right(Range("C" & i).Value, Len(Range("C" & i).Value) - intDashPos)
            
            tmp = getAlpha(strStart)
            If Len(tmp) Then
                strAlpha = tmp
            Else
                MsgBox "Can not find alphabets in the reference" & Chr(10) & "Requires additional information about the reference format" & Chr(10) _
                    & "Failed on line " & i
                Exit Sub
            End If
            
            tmp = getNum(strStart)
            If Len(tmp) Then
                startRow = CLng(tmp)
            Else
                MsgBox "Can not find numbers in the reference" & Chr(10) & "Requires additional information about the reference format" & Chr(10) _
                    & "Failed on line " & i
                Exit Sub
            End If
            
            tmp = getNum(strEnd)
            If Len(tmp) Then
                endRow = CLng(tmp)
            Else
                MsgBox "Can not find numbers in the reference" & Chr(10) & "Requires additional information about the reference format" & Chr(10) _
                    & "Failed on line " & i
                Exit Sub
            End If
            
            'Copy Header
            Range("E1:G1").Value = Range("A1:C1").Value
            
            For j = startRow To endRow
                Range("E" & count).Value = Range("A" & i).Value
                Range("F" & count).Value = Range("B" & i).Value
                Range("G" & count).Value = strAlpha & j
                count = count + 1
            Next j
        Else
            MsgBox "Can not find ""-"" character in the reference" & Chr(10) & "Requires additional information about the reference format" & Chr(10) _
                    & "Failed on line " & i
            Exit Sub
        End If
    Next i
End Sub

Function getAlpha(str$)
    Dim i&
    getAlpha = ""
    For i = 1 To Len(str)
        If Asc(Mid(str, i, 1)) >= 48 And Asc(Mid(str, i, 1)) <= 57 Then
            getAlpha = Left(str, i - 1)
            Exit Function
        End If
    Next i
End Function

Function getNum(str$)
    Dim i&
    getNum = ""
    For i = 1 To Len(str)
        If Asc(Mid(str, i, 1)) >= 48 And Asc(Mid(str, i, 1)) <= 57 Then
            getNum = Right(str, Len(str) - i + 1)
            Exit Function
        End If
    Next i
End Function

The following code will print the results in column E to G starting from Row 1.

Hope it helps

 

[vdevita]

Worked like a charm. Thank you kpark91!

 

[jadouellette2]

I have a similar situation I hope you can help with.
Instead of the reference designator being R1-R4, I have R1-4.
Can the same code be used for this situation?
Thank you