Extracting Values and inserting Rows/Values

[VexedFist]

Anyone know the best way to do this with an Excel Macro.
I have about 35 Files I need to Import Parse.
Here is the raw data Before Import:

ADD-DPLN:1,,,STN,N,,,,,;
ADD-DPLN:200000&&200005,,,STN,N,,,,,;
ADD-DPLN:200007,,,HUNT,N,,,,,;
ADD-DPLN:200009&&200125,,,STN,N,,,,,;

After I Import:
Sub Dpln_Import_Macro()
ChDir "C:\"
Workbooks.OpenText Filename:="C:\Regen Dplan.txt", Origin:=437,
StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True,
Comma:=True, _
Space:=False, Other:=True, OtherChar:=":",
FieldInfo:=Array(Array(1, 9), _
Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6,
2), Array(7, 2), Array(8, 2), _
Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2)),
TrailingMinusNumbers:=True
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
Range("A1:E4").Select
Selection.Copy
Application.CutCopyMode = False
End Sub

This is what I need; to seperate out and Insert the Missing Numbers/
Rows between the "&&" signs, (I.e. the following is output: 200000,
200001, 200002, 200003, 200004, 200005)

1 STN N
200000&&200005 STN N
200007 HUNT N
200009&200125 STN N

I need to Expand the Numbers with an "&&". For example

200000&&200005 STN N

Should end up looking like:

1 STN N
200000 HUNT N
200001 HUNT N
200002 HUNT N
200003 HUNT N
200004 HUNT N
200005 HUNT N
200007 HUNT N
etc...

Any one have any suggestions for accomplishing this?

 

[Joel]

This should work. Your sample data in one location had a single aphersand
instead of two.


Sub dup_rows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
If InStr(Range("A" & RowCount), "&") > 0 Then
Numbers = Range("A" & RowCount)
FirstNum = Val(Trim(Left(Numbers, InStr(Numbers, "&") - 1)))
LastNum = Val(Trim(Mid(Numbers, InStr(Numbers, "&") + 2)))
Set CopyRange = Range("B" & RowCount & ":C" & RowCount)
Range("A" & RowCount) = FirstNum
For NumCount = (FirstNum + 1) To LastNum
Rows(RowCount + 1).Insert
RowCount = RowCount + 1
Range("A" & RowCount) = NumCount
CopyRange.Copy Destination:=Range("B" & RowCount)
Next NumCount
End If
RowCount = RowCount + 1
Loop

End Sub

 

[VexedFist]

This should work.  Your sample data in one location had a single aphersand
instead of two.

Sub dup_rows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
   If InStr(Range("A" & RowCount), "&") > 0 Then
     Numbers = Range("A" & RowCount)
     FirstNum = Val(Trim(Left(Numbers, InStr(Numbers, "&") - 1)))
     LastNum = Val(Trim(Mid(Numbers, InStr(Numbers, "&") + 2)))
     Set CopyRange = Range("B" & RowCount & ":C" & RowCount)
     Range("A" & RowCount) = FirstNum
     For NumCount = (FirstNum + 1) To LastNum
        Rows(RowCount + 1).Insert
        RowCount = RowCount + 1
        Range("A" & RowCount) = NumCount
        CopyRange.Copy Destination:=Range("B" & RowCount)
     Next NumCount
   End If
   RowCount = RowCount + 1
Loop

End Sub












- Show quoted text -

JOEL,

This is not copying the additonal informaiton in the other Cells
(I.e., STN N, or HUNT N).
IS there an easy fix for this?

Thanks for all the assistance on this.

 

[Joel]

My code expects the data to be in columns A - C. The data apparently in
column A is working correctly. the following line of code is used to select
columns B and C. change this line as necessary

Set CopyRange = Range("B" & RowCount & ":C" & RowCount)