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