I have some data that i want to layout in a different format. At present it
is as follows:
Name, Property1, Property2, ... Property172
abc, 786 7684 8965
abd 645 64573 64328
.... (there are 2007 rows)
although there are 172 columns there may not necessarily be an entry in
every column for each name.
I want it to be in the format
Name, Property
abc, 786
abc, 7684
abc, 8965
abd, 645
abd, 64573
abd, 64328
Can anybody help?
Thanks ;o)
I would think that you would really want:
Name, PropertyTitle, Qty/Number/whatever
If you don't want that second column just delete it after you run this macro:
Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim oRow As Long
Dim oCol As Long
Set CurWks = Worksheets(quot;Sheet1quot;)
Set NewWks = Worksheets.Add
NewWks.Range(quot;a1quot;).Resize(1, 3).Value _
= Array(quot;Namequot;, quot;Propertyquot;, quot;Valuequot;)
oRow = 1
With CurWks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
FirstCol = 2
For iRow = FirstRow To LastRow
LastCol = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
For iCol = FirstCol To LastCol
If Trim(.Cells(iRow, iCol)) = quot;quot; Then
'do nothing
Else
oRow = oRow 1
NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
NewWks.Cells(oRow, quot;Bquot;).Value = .Cells(1, iCol).Value
NewWks.Cells(oRow, quot;Cquot;).Value = .Cells(iRow, iCol).Value
End If
Next iCol
Next iRow
End With
NewWks.UsedRange.Columns.AutoFit
End Sub
If you're new to macros, you may want to read David McRitchie's intro at:
www.mvps.org/dmcritchie/excel/getstarted.htmsjn wrote:
gt;
gt; I have some data that i want to layout in a different format. At present it
gt; is as follows:
gt;
gt; Name, Property1, Property2, ... Property172
gt; abc, 786 7684 8965
gt; abd 645 64573 64328
gt; ... (there are 2007 rows)
gt;
gt; although there are 172 columns there may not necessarily be an entry in
gt; every column for each name.
gt;
gt; I want it to be in the format
gt; Name, Property
gt; abc, 786
gt; abc, 7684
gt; abc, 8965
gt; abd, 645
gt; abd, 64573
gt; abd, 64328
gt;
gt; Can anybody help?
gt;
gt; Thanks ;o)
--
Dave Peterson
Awesome. That was perfect. Thanks ;o)
Now for my next question...
An extract of some of the data is below:
Tanunda88530(3-5)
Tanunda885609
Tanunda88561(0-4)
Tanunda88562(0-4)
Tanunda885673
Tanunda88568(6-9)
Tanunda885923
I need to break that out to be:
Tanunda885303
Tanunda885304
Tanunda885305
Tanunda885609
Tanunda885610
Tanunda885611
Tanunda885612
Tanunda885613
Tanunda885614
Tanunda885620
Tanunda885621
Tanunda885622
Tanunda885623
Tanunda885624
Tanunda885673
Tanunda885686
Tanunda885687
Tanunda885688
Tanunda885689
Tanunda885923
Maybe it will be easier to do this as part of the first step?
Cheers
Steve
quot;Dave Petersonquot; wrote:
gt; I would think that you would really want:
gt;
gt; Name, PropertyTitle, Qty/Number/whatever
gt;
gt; If you don't want that second column just delete it after you run this macro:
gt;
gt; Option Explicit
gt; Sub testme()
gt;
gt; Dim CurWks As Worksheet
gt; Dim NewWks As Worksheet
gt; Dim iRow As Long
gt; Dim FirstRow As Long
gt; Dim LastRow As Long
gt; Dim iCol As Long
gt; Dim FirstCol As Long
gt; Dim LastCol As Long
gt; Dim oRow As Long
gt; Dim oCol As Long
gt;
gt; Set CurWks = Worksheets(quot;Sheet1quot;)
gt; Set NewWks = Worksheets.Add
gt;
gt; NewWks.Range(quot;a1quot;).Resize(1, 3).Value _
gt; = Array(quot;Namequot;, quot;Propertyquot;, quot;Valuequot;)
gt;
gt; oRow = 1
gt; With CurWks
gt; FirstRow = 2 'headers in row 1
gt; LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
gt; FirstCol = 2
gt;
gt; For iRow = FirstRow To LastRow
gt; LastCol = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
gt; For iCol = FirstCol To LastCol
gt; If Trim(.Cells(iRow, iCol)) = quot;quot; Then
gt; 'do nothing
gt; Else
gt; oRow = oRow 1
gt; NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
gt; NewWks.Cells(oRow, quot;Bquot;).Value = .Cells(1, iCol).Value
gt; NewWks.Cells(oRow, quot;Cquot;).Value = .Cells(iRow, iCol).Value
gt; End If
gt; Next iCol
gt; Next iRow
gt; End With
gt;
gt; NewWks.UsedRange.Columns.AutoFit
gt;
gt; End Sub
gt;
gt; If you're new to macros, you may want to read David McRitchie's intro at:
gt; www.mvps.org/dmcritchie/excel/getstarted.htm
gt;
gt;
gt; sjn wrote:
gt; gt;
gt; gt; I have some data that i want to layout in a different format. At present it
gt; gt; is as follows:
gt; gt;
gt; gt; Name, Property1, Property2, ... Property172
gt; gt; abc, 786 7684 8965
gt; gt; abd 645 64573 64328
gt; gt; ... (there are 2007 rows)
gt; gt;
gt; gt; although there are 172 columns there may not necessarily be an entry in
gt; gt; every column for each name.
gt; gt;
gt; gt; I want it to be in the format
gt; gt; Name, Property
gt; gt; abc, 786
gt; gt; abc, 7684
gt; gt; abc, 8965
gt; gt; abd, 645
gt; gt; abd, 64573
gt; gt; abd, 64328
gt; gt;
gt; gt; Can anybody help?
gt; gt;
gt; gt; Thanks ;o)
gt;
gt; --
gt;
gt; Dave Peterson
gt;
So you only used column A:B (deleting the column B that the macro created)?Option Explicit
Sub Testme()
'no change to the old code until you get to the bottom....
'....
End With
NewWks.UsedRange.Columns.AutoFit
newwks.range(quot;B1quot;).entirecolumn.delete
Call testme02(newwks)
End Sub
Sub testme02(CurWks As Worksheet)
Dim NewWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim oRow As Long
Dim OpenParenPos As Long
Dim mySplit As Variant
Dim myValue As Variant
Dim myPrefix As Variant
Dim HowMany As Long
Dim iCtr As Long
Dim StartValue As Long
Dim EndValue As Long
Set NewWks = Worksheets.Add
NewWks.Range(quot;a1quot;).Resize(1, 2).Value _
= Array(quot;Namequot;, quot;Valuequot;)
oRow = 2
With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
For iRow = FirstRow To LastRow
myValue = .Cells(iRow, quot;Bquot;).Value
OpenParenPos = InStr(1, myValue, quot;(quot;, vbTextCompare)
If OpenParenPos = 0 Then
NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
NewWks.Cells(oRow, quot;Bquot;).Value = myValue
oRow = oRow 1
Else
myPrefix = Left(myValue, OpenParenPos - 1)
myValue = Mid(myValue, OpenParenPos 1, 255)
'chop final close paren
myValue = Left(myValue, Len(myValue) - 1)
mySplit = Split(myValue, quot;-quot;)
If (UBound(mySplit) - LBound(mySplit)) lt;gt; 1 Then
MsgBox quot;error in: quot; amp; iRow amp; quot;'s column B dataquot; _
amp; quot;Process stoppedquot;
Exit Sub
End If
'no validation here!
StartValue = mySplit(LBound(mySplit))
EndValue = mySplit(UBound(mySplit))
HowMany = EndValue - StartValue 1
NewWks.Cells(oRow, quot;Aquot;).Resize(HowMany).Value _
= .Cells(iRow, quot;Aquot;).Value
For iCtr = StartValue To EndValue Step 1
NewWks.Cells(oRow, quot;Bquot;).Value _
= myPrefix * 10 iCtr
oRow = oRow 1
Next iCtr
End If
Next iRow
End With
NewWks.UsedRange.Columns.AutoFit
End Sub
sjn wrote:
gt;
gt; Awesome. That was perfect. Thanks ;o)
gt;
gt; Now for my next question...
gt; An extract of some of the data is below:
gt; Tanunda 88530(3-5)
gt; Tanunda 885609
gt; Tanunda 88561(0-4)
gt; Tanunda 88562(0-4)
gt; Tanunda 885673
gt; Tanunda 88568(6-9)
gt; Tanunda 885923
gt;
gt; I need to break that out to be:
gt; Tanunda 885303
gt; Tanunda 885304
gt; Tanunda 885305
gt; Tanunda 885609
gt; Tanunda 885610
gt; Tanunda 885611
gt; Tanunda 885612
gt; Tanunda 885613
gt; Tanunda 885614
gt; Tanunda 885620
gt; Tanunda 885621
gt; Tanunda 885622
gt; Tanunda 885623
gt; Tanunda 885624
gt; Tanunda 885673
gt; Tanunda 885686
gt; Tanunda 885687
gt; Tanunda 885688
gt; Tanunda 885689
gt; Tanunda 885923
gt;
gt; Maybe it will be easier to do this as part of the first step?
gt;
gt; Cheers
gt; Steve
gt;
gt; quot;Dave Petersonquot; wrote:
gt;
gt; gt; I would think that you would really want:
gt; gt;
gt; gt; Name, PropertyTitle, Qty/Number/whatever
gt; gt;
gt; gt; If you don't want that second column just delete it after you run this macro:
gt; gt;
gt; gt; Option Explicit
gt; gt; Sub testme()
gt; gt;
gt; gt; Dim CurWks As Worksheet
gt; gt; Dim NewWks As Worksheet
gt; gt; Dim iRow As Long
gt; gt; Dim FirstRow As Long
gt; gt; Dim LastRow As Long
gt; gt; Dim iCol As Long
gt; gt; Dim FirstCol As Long
gt; gt; Dim LastCol As Long
gt; gt; Dim oRow As Long
gt; gt; Dim oCol As Long
gt; gt;
gt; gt; Set CurWks = Worksheets(quot;Sheet1quot;)
gt; gt; Set NewWks = Worksheets.Add
gt; gt;
gt; gt; NewWks.Range(quot;a1quot;).Resize(1, 3).Value _
gt; gt; = Array(quot;Namequot;, quot;Propertyquot;, quot;Valuequot;)
gt; gt;
gt; gt; oRow = 1
gt; gt; With CurWks
gt; gt; FirstRow = 2 'headers in row 1
gt; gt; LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
gt; gt; FirstCol = 2
gt; gt;
gt; gt; For iRow = FirstRow To LastRow
gt; gt; LastCol = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
gt; gt; For iCol = FirstCol To LastCol
gt; gt; If Trim(.Cells(iRow, iCol)) = quot;quot; Then
gt; gt; 'do nothing
gt; gt; Else
gt; gt; oRow = oRow 1
gt; gt; NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
gt; gt; NewWks.Cells(oRow, quot;Bquot;).Value = .Cells(1, iCol).Value
gt; gt; NewWks.Cells(oRow, quot;Cquot;).Value = .Cells(iRow, iCol).Value
gt; gt; End If
gt; gt; Next iCol
gt; gt; Next iRow
gt; gt; End With
gt; gt;
gt; gt; NewWks.UsedRange.Columns.AutoFit
gt; gt;
gt; gt; End Sub
gt; gt;
gt; gt; If you're new to macros, you may want to read David McRitchie's intro at:
gt; gt; www.mvps.org/dmcritchie/excel/getstarted.htm
gt; gt;
gt; gt;
gt; gt; sjn wrote:
gt; gt; gt;
gt; gt; gt; I have some data that i want to layout in a different format. At present it
gt; gt; gt; is as follows:
gt; gt; gt;
gt; gt; gt; Name, Property1, Property2, ... Property172
gt; gt; gt; abc, 786 7684 8965
gt; gt; gt; abd 645 64573 64328
gt; gt; gt; ... (there are 2007 rows)
gt; gt; gt;
gt; gt; gt; although there are 172 columns there may not necessarily be an entry in
gt; gt; gt; every column for each name.
gt; gt; gt;
gt; gt; gt; I want it to be in the format
gt; gt; gt; Name, Property
gt; gt; gt; abc, 786
gt; gt; gt; abc, 7684
gt; gt; gt; abc, 8965
gt; gt; gt; abd, 645
gt; gt; gt; abd, 64573
gt; gt; gt; abd, 64328
gt; gt; gt;
gt; gt; gt; Can anybody help?
gt; gt; gt;
gt; gt; gt; Thanks ;o)
gt; gt;
gt; gt; --
gt; gt;
gt; gt; Dave Peterson
gt; gt;
--
Dave Peterson
Split was added in xl2k.
If you're using xl97, you can add this function:
Function Split97(sStr As String, sdelim As String) As Variant
'from Tom Ogilvy
Split97 = Evaluate(quot;{quot;quot;quot; amp; _
Application.Substitute(sStr, sdelim, quot;quot;quot;,quot;quot;quot;) amp; quot;quot;quot;}quot;)
End Function
And change this line:
mySplit = Split(myValue, quot;-quot;)
to
mySplit = Split97(myValue, quot;-quot;)
Dave Peterson wrote:
gt;
gt; So you only used column A:B (deleting the column B that the macro created)?
gt;
gt; Option Explicit
gt; Sub Testme()
gt;
gt; 'no change to the old code until you get to the bottom....
gt; '....
gt; End With
gt;
gt; NewWks.UsedRange.Columns.AutoFit
gt;
gt; newwks.range(quot;B1quot;).entirecolumn.delete
gt;
gt; Call testme02(newwks)
gt;
gt; End Sub
gt;
gt; Sub testme02(CurWks As Worksheet)
gt;
gt; Dim NewWks As Worksheet
gt; Dim iRow As Long
gt; Dim FirstRow As Long
gt; Dim LastRow As Long
gt; Dim oRow As Long
gt; Dim OpenParenPos As Long
gt; Dim mySplit As Variant
gt; Dim myValue As Variant
gt; Dim myPrefix As Variant
gt; Dim HowMany As Long
gt; Dim iCtr As Long
gt; Dim StartValue As Long
gt; Dim EndValue As Long
gt;
gt; Set NewWks = Worksheets.Add
gt;
gt; NewWks.Range(quot;a1quot;).Resize(1, 2).Value _
gt; = Array(quot;Namequot;, quot;Valuequot;)
gt;
gt; oRow = 2
gt; With CurWks
gt; FirstRow = 2
gt; LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
gt;
gt; For iRow = FirstRow To LastRow
gt; myValue = .Cells(iRow, quot;Bquot;).Value
gt; OpenParenPos = InStr(1, myValue, quot;(quot;, vbTextCompare)
gt; If OpenParenPos = 0 Then
gt; NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
gt; NewWks.Cells(oRow, quot;Bquot;).Value = myValue
gt; oRow = oRow 1
gt; Else
gt; myPrefix = Left(myValue, OpenParenPos - 1)
gt; myValue = Mid(myValue, OpenParenPos 1, 255)
gt; 'chop final close paren
gt; myValue = Left(myValue, Len(myValue) - 1)
gt;
gt; mySplit = Split(myValue, quot;-quot;)
gt; If (UBound(mySplit) - LBound(mySplit)) lt;gt; 1 Then
gt; MsgBox quot;error in: quot; amp; iRow amp; quot;'s column B dataquot; _
gt; amp; quot;Process stoppedquot;
gt; Exit Sub
gt; End If
gt; 'no validation here!
gt; StartValue = mySplit(LBound(mySplit))
gt; EndValue = mySplit(UBound(mySplit))
gt; HowMany = EndValue - StartValue 1
gt; NewWks.Cells(oRow, quot;Aquot;).Resize(HowMany).Value _
gt; = .Cells(iRow, quot;Aquot;).Value
gt; For iCtr = StartValue To EndValue Step 1
gt; NewWks.Cells(oRow, quot;Bquot;).Value _
gt; = myPrefix * 10 iCtr
gt; oRow = oRow 1
gt; Next iCtr
gt; End If
gt; Next iRow
gt; End With
gt;
gt; NewWks.UsedRange.Columns.AutoFit
gt;
gt; End Sub
gt;
gt; sjn wrote:
gt; gt;
gt; gt; Awesome. That was perfect. Thanks ;o)
gt; gt;
gt; gt; Now for my next question...
gt; gt; An extract of some of the data is below:
gt; gt; Tanunda 88530(3-5)
gt; gt; Tanunda 885609
gt; gt; Tanunda 88561(0-4)
gt; gt; Tanunda 88562(0-4)
gt; gt; Tanunda 885673
gt; gt; Tanunda 88568(6-9)
gt; gt; Tanunda 885923
gt; gt;
gt; gt; I need to break that out to be:
gt; gt; Tanunda 885303
gt; gt; Tanunda 885304
gt; gt; Tanunda 885305
gt; gt; Tanunda 885609
gt; gt; Tanunda 885610
gt; gt; Tanunda 885611
gt; gt; Tanunda 885612
gt; gt; Tanunda 885613
gt; gt; Tanunda 885614
gt; gt; Tanunda 885620
gt; gt; Tanunda 885621
gt; gt; Tanunda 885622
gt; gt; Tanunda 885623
gt; gt; Tanunda 885624
gt; gt; Tanunda 885673
gt; gt; Tanunda 885686
gt; gt; Tanunda 885687
gt; gt; Tanunda 885688
gt; gt; Tanunda 885689
gt; gt; Tanunda 885923
gt; gt;
gt; gt; Maybe it will be easier to do this as part of the first step?
gt; gt;
gt; gt; Cheers
gt; gt; Steve
gt; gt;
gt; gt; quot;Dave Petersonquot; wrote:
gt; gt;
gt; gt; gt; I would think that you would really want:
gt; gt; gt;
gt; gt; gt; Name, PropertyTitle, Qty/Number/whatever
gt; gt; gt;
gt; gt; gt; If you don't want that second column just delete it after you run this macro:
gt; gt; gt;
gt; gt; gt; Option Explicit
gt; gt; gt; Sub testme()
gt; gt; gt;
gt; gt; gt; Dim CurWks As Worksheet
gt; gt; gt; Dim NewWks As Worksheet
gt; gt; gt; Dim iRow As Long
gt; gt; gt; Dim FirstRow As Long
gt; gt; gt; Dim LastRow As Long
gt; gt; gt; Dim iCol As Long
gt; gt; gt; Dim FirstCol As Long
gt; gt; gt; Dim LastCol As Long
gt; gt; gt; Dim oRow As Long
gt; gt; gt; Dim oCol As Long
gt; gt; gt;
gt; gt; gt; Set CurWks = Worksheets(quot;Sheet1quot;)
gt; gt; gt; Set NewWks = Worksheets.Add
gt; gt; gt;
gt; gt; gt; NewWks.Range(quot;a1quot;).Resize(1, 3).Value _
gt; gt; gt; = Array(quot;Namequot;, quot;Propertyquot;, quot;Valuequot;)
gt; gt; gt;
gt; gt; gt; oRow = 1
gt; gt; gt; With CurWks
gt; gt; gt; FirstRow = 2 'headers in row 1
gt; gt; gt; LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
gt; gt; gt; FirstCol = 2
gt; gt; gt;
gt; gt; gt; For iRow = FirstRow To LastRow
gt; gt; gt; LastCol = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
gt; gt; gt; For iCol = FirstCol To LastCol
gt; gt; gt; If Trim(.Cells(iRow, iCol)) = quot;quot; Then
gt; gt; gt; 'do nothing
gt; gt; gt; Else
gt; gt; gt; oRow = oRow 1
gt; gt; gt; NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
gt; gt; gt; NewWks.Cells(oRow, quot;Bquot;).Value = .Cells(1, iCol).Value
gt; gt; gt; NewWks.Cells(oRow, quot;Cquot;).Value = .Cells(iRow, iCol).Value
gt; gt; gt; End If
gt; gt; gt; Next iCol
gt; gt; gt; Next iRow
gt; gt; gt; End With
gt; gt; gt;
gt; gt; gt; NewWks.UsedRange.Columns.AutoFit
gt; gt; gt;
gt; gt; gt; End Sub
gt; gt; gt;
gt; gt; gt; If you're new to macros, you may want to read David McRitchie's intro at:
gt; gt; gt; www.mvps.org/dmcritchie/excel/getstarted.htm
gt; gt; gt;
gt; gt; gt;
gt; gt; gt; sjn wrote:
gt; gt; gt; gt;
gt; gt; gt; gt; I have some data that i want to layout in a different format. At present it
gt; gt; gt; gt; is as follows:
gt; gt; gt; gt;
gt; gt; gt; gt; Name, Property1, Property2, ... Property172
gt; gt; gt; gt; abc, 786 7684 8965
gt; gt; gt; gt; abd 645 64573 64328
gt; gt; gt; gt; ... (there are 2007 rows)
gt; gt; gt; gt;
gt; gt; gt; gt; although there are 172 columns there may not necessarily be an entry in
gt; gt; gt; gt; every column for each name.
gt; gt; gt; gt;
gt; gt; gt; gt; I want it to be in the format
gt; gt; gt; gt; Name, Property
gt; gt; gt; gt; abc, 786
gt; gt; gt; gt; abc, 7684
gt; gt; gt; gt; abc, 8965
gt; gt; gt; gt; abd, 645
gt; gt; gt; gt; abd, 64573
gt; gt; gt; gt; abd, 64328
gt; gt; gt; gt;
gt; gt; gt; gt; Can anybody help?
gt; gt; gt; gt;
gt; gt; gt; gt; Thanks ;o)
gt; gt; gt;
gt; gt; gt; --
gt; gt; gt;
gt; gt; gt; Dave Peterson
gt; gt; gt;
gt;
gt; --
gt;
gt; Dave Peterson
--
Dave Peterson
Can't thank you enough for that. Saved me loads of work!!
Cheers
Steve
quot;Dave Petersonquot; wrote:
gt; So you only used column A:B (deleting the column B that the macro created)?
gt;
gt;
gt; Option Explicit
gt; Sub Testme()
gt;
gt; 'no change to the old code until you get to the bottom....
gt; '....
gt; End With
gt;
gt; NewWks.UsedRange.Columns.AutoFit
gt;
gt; newwks.range(quot;B1quot;).entirecolumn.delete
gt;
gt; Call testme02(newwks)
gt;
gt; End Sub
gt;
gt; Sub testme02(CurWks As Worksheet)
gt;
gt; Dim NewWks As Worksheet
gt; Dim iRow As Long
gt; Dim FirstRow As Long
gt; Dim LastRow As Long
gt; Dim oRow As Long
gt; Dim OpenParenPos As Long
gt; Dim mySplit As Variant
gt; Dim myValue As Variant
gt; Dim myPrefix As Variant
gt; Dim HowMany As Long
gt; Dim iCtr As Long
gt; Dim StartValue As Long
gt; Dim EndValue As Long
gt;
gt; Set NewWks = Worksheets.Add
gt;
gt; NewWks.Range(quot;a1quot;).Resize(1, 2).Value _
gt; = Array(quot;Namequot;, quot;Valuequot;)
gt;
gt; oRow = 2
gt; With CurWks
gt; FirstRow = 2
gt; LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
gt;
gt; For iRow = FirstRow To LastRow
gt; myValue = .Cells(iRow, quot;Bquot;).Value
gt; OpenParenPos = InStr(1, myValue, quot;(quot;, vbTextCompare)
gt; If OpenParenPos = 0 Then
gt; NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
gt; NewWks.Cells(oRow, quot;Bquot;).Value = myValue
gt; oRow = oRow 1
gt; Else
gt; myPrefix = Left(myValue, OpenParenPos - 1)
gt; myValue = Mid(myValue, OpenParenPos 1, 255)
gt; 'chop final close paren
gt; myValue = Left(myValue, Len(myValue) - 1)
gt;
gt; mySplit = Split(myValue, quot;-quot;)
gt; If (UBound(mySplit) - LBound(mySplit)) lt;gt; 1 Then
gt; MsgBox quot;error in: quot; amp; iRow amp; quot;'s column B dataquot; _
gt; amp; quot;Process stoppedquot;
gt; Exit Sub
gt; End If
gt; 'no validation here!
gt; StartValue = mySplit(LBound(mySplit))
gt; EndValue = mySplit(UBound(mySplit))
gt; HowMany = EndValue - StartValue 1
gt; NewWks.Cells(oRow, quot;Aquot;).Resize(HowMany).Value _
gt; = .Cells(iRow, quot;Aquot;).Value
gt; For iCtr = StartValue To EndValue Step 1
gt; NewWks.Cells(oRow, quot;Bquot;).Value _
gt; = myPrefix * 10 iCtr
gt; oRow = oRow 1
gt; Next iCtr
gt; End If
gt; Next iRow
gt; End With
gt;
gt; NewWks.UsedRange.Columns.AutoFit
gt;
gt; End Sub
gt;
gt; sjn wrote:
gt; gt;
gt; gt; Awesome. That was perfect. Thanks ;o)
gt; gt;
gt; gt; Now for my next question...
gt; gt; An extract of some of the data is below:
gt; gt; Tanunda 88530(3-5)
gt; gt; Tanunda 885609
gt; gt; Tanunda 88561(0-4)
gt; gt; Tanunda 88562(0-4)
gt; gt; Tanunda 885673
gt; gt; Tanunda 88568(6-9)
gt; gt; Tanunda 885923
gt; gt;
gt; gt; I need to break that out to be:
gt; gt; Tanunda 885303
gt; gt; Tanunda 885304
gt; gt; Tanunda 885305
gt; gt; Tanunda 885609
gt; gt; Tanunda 885610
gt; gt; Tanunda 885611
gt; gt; Tanunda 885612
gt; gt; Tanunda 885613
gt; gt; Tanunda 885614
gt; gt; Tanunda 885620
gt; gt; Tanunda 885621
gt; gt; Tanunda 885622
gt; gt; Tanunda 885623
gt; gt; Tanunda 885624
gt; gt; Tanunda 885673
gt; gt; Tanunda 885686
gt; gt; Tanunda 885687
gt; gt; Tanunda 885688
gt; gt; Tanunda 885689
gt; gt; Tanunda 885923
gt; gt;
gt; gt; Maybe it will be easier to do this as part of the first step?
gt; gt;
gt; gt; Cheers
gt; gt; Steve
gt; gt;
gt; gt; quot;Dave Petersonquot; wrote:
gt; gt;
gt; gt; gt; I would think that you would really want:
gt; gt; gt;
gt; gt; gt; Name, PropertyTitle, Qty/Number/whatever
gt; gt; gt;
gt; gt; gt; If you don't want that second column just delete it after you run this macro:
gt; gt; gt;
gt; gt; gt; Option Explicit
gt; gt; gt; Sub testme()
gt; gt; gt;
gt; gt; gt; Dim CurWks As Worksheet
gt; gt; gt; Dim NewWks As Worksheet
gt; gt; gt; Dim iRow As Long
gt; gt; gt; Dim FirstRow As Long
gt; gt; gt; Dim LastRow As Long
gt; gt; gt; Dim iCol As Long
gt; gt; gt; Dim FirstCol As Long
gt; gt; gt; Dim LastCol As Long
gt; gt; gt; Dim oRow As Long
gt; gt; gt; Dim oCol As Long
gt; gt; gt;
gt; gt; gt; Set CurWks = Worksheets(quot;Sheet1quot;)
gt; gt; gt; Set NewWks = Worksheets.Add
gt; gt; gt;
gt; gt; gt; NewWks.Range(quot;a1quot;).Resize(1, 3).Value _
gt; gt; gt; = Array(quot;Namequot;, quot;Propertyquot;, quot;Valuequot;)
gt; gt; gt;
gt; gt; gt; oRow = 1
gt; gt; gt; With CurWks
gt; gt; gt; FirstRow = 2 'headers in row 1
gt; gt; gt; LastRow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row
gt; gt; gt; FirstCol = 2
gt; gt; gt;
gt; gt; gt; For iRow = FirstRow To LastRow
gt; gt; gt; LastCol = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
gt; gt; gt; For iCol = FirstCol To LastCol
gt; gt; gt; If Trim(.Cells(iRow, iCol)) = quot;quot; Then
gt; gt; gt; 'do nothing
gt; gt; gt; Else
gt; gt; gt; oRow = oRow 1
gt; gt; gt; NewWks.Cells(oRow, quot;Aquot;).Value = .Cells(iRow, quot;Aquot;).Value
gt; gt; gt; NewWks.Cells(oRow, quot;Bquot;).Value = .Cells(1, iCol).Value
gt; gt; gt; NewWks.Cells(oRow, quot;Cquot;).Value = .Cells(iRow, iCol).Value
gt; gt; gt; End If
gt; gt; gt; Next iCol
gt; gt; gt; Next iRow
gt; gt; gt; End With
gt; gt; gt;
gt; gt; gt; NewWks.UsedRange.Columns.AutoFit
gt; gt; gt;
gt; gt; gt; End Sub
gt; gt; gt;
gt; gt; gt; If you're new to macros, you may want to read David McRitchie's intro at:
gt; gt; gt; www.mvps.org/dmcritchie/excel/getstarted.htm
gt; gt; gt;
gt; gt; gt;
gt; gt; gt; sjn wrote:
gt; gt; gt; gt;
gt; gt; gt; gt; I have some data that i want to layout in a different format. At present it
gt; gt; gt; gt; is as follows:
gt; gt; gt; gt;
gt; gt; gt; gt; Name, Property1, Property2, ... Property172
gt; gt; gt; gt; abc, 786 7684 8965
gt; gt; gt; gt; abd 645 64573 64328
gt; gt; gt; gt; ... (there are 2007 rows)
gt; gt; gt; gt;
gt; gt; gt; gt; although there are 172 columns there may not necessarily be an entry in
gt; gt; gt; gt; every column for each name.
gt; gt; gt; gt;
gt; gt; gt; gt; I want it to be in the format
gt; gt; gt; gt; Name, Property
gt; gt; gt; gt; abc, 786
gt; gt; gt; gt; abc, 7684
gt; gt; gt; gt; abc, 8965
gt; gt; gt; gt; abd, 645
gt; gt; gt; gt; abd, 64573
gt; gt; gt; gt; abd, 64328
gt; gt; gt; gt;
gt; gt; gt; gt; Can anybody help?
gt; gt; gt; gt;
gt; gt; gt; gt; Thanks ;o)
gt; gt; gt;
gt; gt; gt; --
gt; gt; gt;
gt; gt; gt; Dave Peterson
gt; gt; gt;
gt;
gt; --
gt;
gt; Dave Peterson
gt;
留言列表
