Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
I want to convert a table to a list
I am still struggling with VBA. I have not been able to find a similar example. Can anyone help ? Thank you. Wayne. Input table - WorkSheet A ------------------------- Week1 Week2 Week3 week4 Activity 1 1 Activity 2 2 3 Activity 3 2 5 4 Wanted output list on WorkSheet B Desc Activity Qty ----------------------------------- Week 1 Activity 1 1 Week 1 Activity 3 2 Week 2 Activity 2 2 Week 3 Activity 3 5 Week 4 Activity 2 3 Week 4 Activity 3 4 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
This is not a very sophisticated response, however, it will do the job.
Might be a good guide for a start. Sub BuildTable() Dim strWeek As String, strActivity As String, intRow As Integer, intCol As Integer Dim strQty As String, strRange As String 'Go to New Sheet and prepare table header Sheets("Sheet2").Select 'Range("A1").Select 'raises error 1004 "not defined" ??? ActiveCell.Select ActiveCell.Formula = "Desc" 'Range("B1").Select 'raises error 1004 "not defined" ??? ActiveCell.Offset(0, 1).Select ActiveCell.Formula = "Activity" 'Range("C1").Select 'raises error 1004 "not defined" ??? ActiveCell.Offset(0, 1).Select ActiveCell.Formula = "Qty" ActiveCell.Offset(1, -2).Select 'Return to original data Sheets("Sheet1").Select 'Cycle through original data For intCol = 2 To 5 'For each column Select Case intCol Case 2: strRange = "B" Case 3: strRange = "C" Case 4: strRange = "D" Case 5: strRange = "E" End Select Range(strRange & "2").Select 'Collect the column title ActiveCell.Offset(-1, 0).Select strWeek = ActiveCell.Text ActiveCell.Offset(1, 0).Select For intRow = 2 To 4 ' For each Row Range(strRange & CStr(intRow)).Select 'Collect the row title ActiveCell.Offset(0, -intCol + 1).Select strActivity = ActiveCell.Text ActiveCell.Offset(0, intCol - 1).Select 'if there is a quantity in the cell If ActiveCell.Text < "" Then strQty = ActiveCell.Text Sheets("Sheet2").Select 'Range("A2").Select While ActiveCell.Text < "" ActiveCell.Offset(1, 0).Select Wend ActiveCell.Formula = strWeek ActiveCell.Offset(0, 1).Select ActiveCell.Formula = strActivity ActiveCell.Offset(0, 1).Select ActiveCell.Formula = strQty ActiveCell.Offset(1, -2).Select Sheets("Sheet1").Select End If Next intRow Next intCol End Sub Good luck from Tasmania " wrote: I want to convert a table to a list I am still struggling with VBA. I have not been able to find a similar example. Can anyone help ? Thank you. Wayne. Input table - WorkSheet A ------------------------- Week1 Week2 Week3 week4 Activity 1 1 Activity 2 2 3 Activity 3 2 5 4 Wanted output list on WorkSheet B Desc Activity Qty ----------------------------------- Week 1 Activity 1 1 Week 1 Activity 3 2 Week 2 Activity 2 2 Week 3 Activity 3 5 Week 4 Activity 2 3 Week 4 Activity 3 4 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
Thanks again.
What is the expected development of such line ? Error trapping ? 'Range("A1").Select 'raises error 1004 "not defined" ??? .... and if so can you give me some continuations ? This exercise was definetely what the Doctor ordered. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
One more...
Option Explicit Sub testme() Dim NewWks As Worksheet Dim CurWks As Worksheet Dim iRow As Long Dim iCol As Long Dim oRow As Long Set CurWks = Worksheets("Sheet1") Set NewWks = Worksheets.Add NewWks.Range("a1").Resize(1, 3).Value _ = Array("Desc", "Activity", "Qty") oRow = 1 With CurWks For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row For iCol = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column If Trim(.Cells(iRow, iCol).Value) = "" Then 'do nothing Else oRow = oRow + 1 NewWks.Cells(oRow, "A").Value = .Cells(1, iCol).Value NewWks.Cells(oRow, "B").Value = .Cells(iRow, "A").Value NewWks.Cells(oRow, "C").Value = .Cells(iRow, iCol).Value End If Next iCol Next iRow End With NewWks.UsedRange.Columns.AutoFit End Sub wrote: I want to convert a table to a list I am still struggling with VBA. I have not been able to find a similar example. Can anyone help ? Thank you. Wayne. Input table - WorkSheet A ------------------------- Week1 Week2 Week3 week4 Activity 1 1 Activity 2 2 3 Activity 3 2 5 4 Wanted output list on WorkSheet B Desc Activity Qty ----------------------------------- Week 1 Activity 1 1 Week 1 Activity 3 2 Week 2 Activity 2 2 Week 3 Activity 3 5 Week 4 Activity 2 3 Week 4 Activity 3 4 -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
And another...
Public Sub ChangeTable() Dim I As Long Dim J As Long Dim NewSheet As Worksheet Dim iRow As Long Dim vaNewTable() As Variant Dim vaOldTable As Variant Dim iLastRow As Long Dim iLastColumn As Integer iLastRow = Cells(Range("A:A").Rows.Count, 2).End(xlUp).Row iLastColumn = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column vaOldTable = Range(Cells(2, 2), Cells(iLastRow, iLastColumn)).Value Dim vaWeek As Variant Dim vaActivity As Variant vaWeek = Range(Cells(1, 2), Cells(1, iLastColumn)) vaActivity = Range(Cells(2, 1), Cells(iLastRow, 1)) For I = 1 To UBound(vaWeek, 2) For J = 1 To UBound(vaActivity, 1) If vaOldTable(J, I) < "" Then iRow = iRow + 1 ReDim Preserve vaNewTable(3, iRow) vaNewTable(3, iRow) = vaOldTable(J, I) vaNewTable(2, iRow) = vaActivity(J, 1) vaNewTable(1, iRow) = vaWeek(1, I) End If Next J Next I Set NewSheet = Worksheets.Add NewSheet.Name = "Sheet" & ActiveWorkbook.Worksheets.Count Range("A1").Value = "Desc" Range("B1").Value = "Activity" Range("C1").Value = "Qty" Range("A2").Resize(UBound(vaNewTable, 2), UBound(vaNewTable, 1)) = _ WorksheetFunction.Transpose(vaNewTable) End Sub Good luck from mainland Australia:-) Ken Johnson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
Oops, left out Option Base One Option Base 1 Option Explicit Public Sub ChangeTable() Dim I As Long Dim J As Long Dim NewSheet As Worksheet Dim iRow As Long Dim vaNewTable() As Variant Dim vaOldTable As Variant Dim iLastRow As Long Dim iLastColumn As Integer iLastRow = Cells(Range("A:A").Rows.Count, 2).End(xlUp).Row iLastColumn = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column vaOldTable = Range(Cells(2, 2), Cells(iLastRow, iLastColumn)).Value Dim vaWeek As Variant Dim vaActivity As Variant vaWeek = Range(Cells(1, 2), Cells(1, iLastColumn)) vaActivity = Range(Cells(2, 1), Cells(iLastRow, 1)) For I = 1 To UBound(vaWeek, 2) For J = 1 To UBound(vaActivity, 1) If vaOldTable(J, I) < "" Then iRow = iRow + 1 ReDim Preserve vaNewTable(3, iRow) vaNewTable(3, iRow) = vaOldTable(J, I) vaNewTable(2, iRow) = vaActivity(J, 1) vaNewTable(1, iRow) = vaWeek(1, I) End If Next J Next I Set NewSheet = Worksheets.Add NewSheet.Name = "Sheet" & ActiveWorkbook.Worksheets.Count Range("A1").Value = "Desc" Range("B1").Value = "Activity" Range("C1").Value = "Qty" Range("A2").Resize(UBound(vaNewTable, 2), UBound(vaNewTable, 1)) = _ WorksheetFunction.Transpose(vaNewTable) End Sub Typical, Aye. Ken Johnson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
Wooww !!! I am baffled by the quality of the response
My grasping of VBA logic & syntax went from 5 to 8. Thank you all. Wayne Now, I am pushing it one step further. Can you help me again ? Namely : 1. Calling Closed Workbook "A" from Active Workbook "B" 2. A second row of column headers 3. A new column "Price" and a calculated column "Cost" being the result of Price x Qty Input table - WorkBook A ------------------------- Price Week1 Week1 Week2 Week2 AM PM AM PM Activity 1 3 1 Activity 2 7 2 3 Activity 3 5 2 5 4 Wanted output list on WorkBook B Desc Period Activity Qty Price Cost --------------------------------------------------- Week 1 AM Activity 1 1 3 3 Week 1 AM Activity 3 2 5 10 Week 1 PM Activity 2 2 7 14 Week 2 AM Activity 3 5 5 25 Week 2 PM Activity 2 3 7 21 Week 2 PM Activity 3 4 5 20 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Convert an Excel table to a list with VBA
I wasn't sure if you wanted a value in the Cost (I call that extended price--not
cost) or just the value, so you'll have to delete Open workbook A first. Then assign the CurWks variable to that workbook. Set CurWks = Worksheets("Sheet1") becomes: Set CurWks = workbooks("workbookA.xls").Worksheets("Sheet1") (change the workbook name and sheet name accordingly. And this line Set NewWks = Worksheets.Add can become: Set NewWks = thisworkbook.Worksheets.Add or Set NewWks = activeworkbook.Worksheets.Add depending on what workbook should get the new sheet--the workbook with the code or the workbook that you're looking at in excel. Option Explicit Sub testme2() Dim NewWks As Worksheet Dim CurWks As Worksheet Dim iRow As Long Dim iCol As Long Dim oRow As Long Set CurWks = Worksheets("Sheet1") Set NewWks = Worksheets.Add NewWks.Range("a1").Resize(1, 6).Value _ = Array("Desc", "Period", "Activity", "Qty", "Price", "Ext Price") oRow = 1 With CurWks For iRow = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row For iCol = 3 To .Cells(1, .Columns.Count).End(xlToLeft).Column If Trim(.Cells(iRow, iCol).Value) = "" Then 'do nothing Else oRow = oRow + 1 'desc (always row 1) NewWks.Cells(oRow, "A").Value = .Cells(1, iCol).Value 'Period (always row 2) NewWks.Cells(oRow, "B").Value = .Cells(2, iCol).Value 'Activity (always column A) NewWks.Cells(oRow, "C").Value = .Cells(iRow, "A").Value 'Qty (in the data) NewWks.Cells(oRow, "D").Value = .Cells(iRow, iCol).Value 'Price (always column B) NewWks.Cells(oRow, "E").Value = .Cells(iRow, "B").Value 'Extended Price (a formula or a value??) 'if formula NewWks.Cells(oRow, "F").FormulaR1C1 _ = "=rc[-2]*rc[-1]" 'if value 'NewWks.Cells(oRow, "F").Value _ ' = .Cells(iRow, iCol).Value * .Cells(iRow, "B").Value End If Next iCol Next iRow End With NewWks.UsedRange.Columns.AutoFit End Sub =============== And if you really want the code to open the workbook A, you can do this: Option Explicit Sub testme2() Dim WkbkA As Workbook Dim WkbkAName As String Dim WkbkAPath As String Dim CurWksName As String Dim CurWks As Worksheet Dim TestStr As String Dim WkbkAWasOpen As Boolean Dim NewWks As Worksheet Dim iRow As Long Dim iCol As Long Dim oRow As Long 'Change the next few lines to match what you need. WkbkAPath = "C:\my documents\excel" If Right(WkbkAPath, 1) < "\" Then WkbkAPath = WkbkAPath & "\" End If WkbkAName = "book2.xls" CurWksName = "sheet12" TestStr = "" On Error Resume Next TestStr = Dir(WkbkAPath & WkbkAName) On Error GoTo 0 If TestStr = "" Then MsgBox "That other workbook doesn't exist" Exit Sub End If WkbkAWasOpen = True Set WkbkA = Nothing On Error Resume Next Set WkbkA = Workbooks(WkbkAName) On Error GoTo 0 If WkbkA Is Nothing Then 'it's not open, so open it Set WkbkA = Workbooks.Open(Filename:=WkbkAPath & WkbkAName, _ ReadOnly:=True) WkbkAWasOpen = False End If Set CurWks = Nothing On Error Resume Next Set CurWks = WkbkA.Worksheets(CurWksName) On Error GoTo 0 If CurWks Is Nothing Then MsgBox "That worksheet doesn't exist!" Else Set NewWks = ThisWorkbook.Worksheets.Add NewWks.Range("a1").Resize(1, 6).Value _ = Array("Desc", "Period", "Activity", "Qty", "Price", "Ext Price") oRow = 1 With CurWks For iRow = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row For iCol = 3 To .Cells(1, .Columns.Count).End(xlToLeft).Column If Trim(.Cells(iRow, iCol).Value) = "" Then 'do nothing Else oRow = oRow + 1 'desc (always row 1) NewWks.Cells(oRow, "A").Value = .Cells(1, iCol).Value 'Period (always row 2) NewWks.Cells(oRow, "B").Value = .Cells(2, iCol).Value 'Activity (always column A) NewWks.Cells(oRow, "C").Value = .Cells(iRow, "A").Value 'Qty (in the data) NewWks.Cells(oRow, "D").Value _ = .Cells(iRow, iCol).Value 'Price (always column B) NewWks.Cells(oRow, "E").Value = .Cells(iRow, "B").Value 'Extended Price (a formula or a value??) 'if formula NewWks.Cells(oRow, "F").FormulaR1C1 _ = "=rc[-2]*rc[-1]" 'if value 'NewWks.Cells(oRow, "F").Value _ ' = .Cells(iRow, iCol).Value * .Cells(iRow, "B").Value End If Next iCol Next iRow End With NewWks.UsedRange.Columns.AutoFit End If 'clean up If WkbkAWasOpen Then 'do nothing Else WkbkA.Close savechanges:=False End If End Sub wrote: Wooww !!! I am baffled by the quality of the response My grasping of VBA logic & syntax went from 5 to 8. Thank you all. Wayne Now, I am pushing it one step further. Can you help me again ? Namely : 1. Calling Closed Workbook "A" from Active Workbook "B" 2. A second row of column headers 3. A new column "Price" and a calculated column "Cost" being the result of Price x Qty Input table - WorkBook A ------------------------- Price Week1 Week1 Week2 Week2 AM PM AM PM Activity 1 3 1 Activity 2 7 2 3 Activity 3 5 2 5 4 Wanted output list on WorkBook B Desc Period Activity Qty Price Cost --------------------------------------------------- Week 1 AM Activity 1 1 3 3 Week 1 AM Activity 3 2 5 10 Week 1 PM Activity 2 2 7 14 Week 2 AM Activity 3 5 5 25 Week 2 PM Activity 2 3 7 21 Week 2 PM Activity 3 4 5 20 -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I convert a table into a list in excel? | Excel Worksheet Functions | |||
Convert list to table | Excel Discussion (Misc queries) | |||
How to convert a table to list? | Excel Worksheet Functions | |||
How to convert existing Excel List into a table in Access? | New Users to Excel | |||
convert excel list to pivot table | Excel Discussion (Misc queries) |