Urgent help needed
Thanks very much guys!
"NickHK" wrote:
Cathy,
I changed it to VBA style, which as you can is not much different.
Added a loop for each worksheet and declared all variable type and added
"Option Explicit"
Not tested at all, but it should get you started in Excel.
Just open Excel with a new file.
Show the Control Toolbox, if not visible (ViewToolbarsControl Box).
Add a Command Button.
Double click this new button to open the VBA IDE.
Paste this code, making sure you do not have 2 x "Private Sub
CommandButton1_Click()" or 2 x "End Sub",
You can delete the comments showing the parts that are not used in VBA if
you wish.
Option Explicit
Private Sub CommandButton1_Click()
'Dim fso, workingFolder, files, currentFile
Dim FolderName As String, FileName As String, FilePath As String
Dim MasterWorkbookPath As String, MasterWorkbook As Workbook, MasterWS As
Worksheet
Dim ChildWorkbook As Workbook, ChildWS As Worksheet
Dim TestName As String, TestDescription As String
Dim StepExpectedResults As Variant, StepComments As String, StepDescription
As String, StepName As Long
Dim NoMoreRows As Boolean, WriteRow As Boolean
Dim CurrentRow As Long, CurrentWriteRow As Long
'Dim currentStep,
FolderName = "C:\testsToBeImported\"
MasterWorkbookPath = "C:\masterWorkbook.xls"
'Set fso = CreateObject("Scripting.FileSystemObject")
'Application.Visible = False
'Application.DisplayAlerts = False
Set MasterWorkbook = Application.Workbooks.Open(MasterWorkbookPath)
Set MasterWS = MasterWorkbook.Worksheets("import")
FileName = Dir(FolderName & "*.xls")
Do While FileName < ""
'Set workingFolder = fso.GetFolder(FolderName)
'Set files = workingFolder.files
CurrentWriteRow = 2
'For Each currentFile In files
'FileName = currentFile.Name
FilePath = FolderName & FileName
'MsgBox fileName
Set ChildWorkbook = Application.Workbooks.Open(FilePath)
'***
'***Added to loop through all worksheets
'***
For Each ChildWS In ChildWorkbook.Worksheets
With ChildWS
TestName = .Cells(1, 3).Value
TestDescription = "Objective: " & .Cells(2, 3).Value
TestDescription = TestDescription & Chr(13) & "Data Set: " &
..Cells(6, 4).Value
TestDescription = TestDescription & Chr(13) & "Login Used: " &
..Cells(7, 4).Value
TestDescription = TestDescription & Chr(13) & "Preconditions: "
& .Cells(8, 4).Value
CurrentRow = 11
NoMoreRows = False
WriteRow = False
StepName = 1
Do
StepDescription = .Cells(CurrentRow, 2).Value
'MsgBox stepDescription
'As StepDescription is declared as String,
IsNull(StepDescription) cannot = False
If Len(StepDescription) < 2 Then 'Or
(IsNull(StepDescription))) Then
CurrentRow = CurrentRow + 1
StepDescription = .Cells(CurrentRow, 2).Value
'As StepDescription is declared as String,
IsNull(StepDescription) cannot = False
If Len(StepDescription) < 2 Then 'Or
(IsNull(StepDescription))) Then
NoMoreRows = True
WriteRow = False
Else
WriteRow = True
End If
Else
WriteRow = True
End If
If WriteRow Then
StepExpectedResults = .Cells(CurrentRow, 4).Value
StepComments = .Cells(CurrentRow, 3).Value
StepDescription = StepDescription & Chr(13) & Chr(13) &
"Comments/Data: " & StepComments
MasterWS.Cells(CurrentWriteRow, 1).Value = "Import"
MasterWS.Cells(CurrentWriteRow, 2).Value = TestName
MasterWS.Cells(CurrentWriteRow, 3).Value =
TestDescription
MasterWS.Cells(CurrentWriteRow, 4).Value = StepName
MasterWS.Cells(CurrentWriteRow, 5).Value =
StepDescription
MasterWS.Cells(CurrentWriteRow, 6).Value =
StepExpectedResults
CurrentRow = CurrentRow + 1
CurrentWriteRow = CurrentWriteRow + 1
StepName = StepName + 1
End If
Loop Until NoMoreRows
End With
Next
ChildWorkbook.Close True, FilePath
'Set ChildWorkbook = Nothing
FileName = Dir()
Loop
MasterWorkbook.Save
MasterWorkbook.Close True, MasterWorkbookPath
'Application.Quit
'Set Application = Nothing
MsgBox "Import Formating Complete"
End Sub
NickHK
"Catherine Jackson" wrote in
message ...
Nick,
I never used VBA/Excel before. Would it be easier to do so? Any tips?
"NickHK" wrote:
Any reason you are using VBScript instead of Excel/VBA ?
NickHK
"Catherine Jackson" wrote
in
message ...
Hi,
I posted a message earlier but didn't get a response yet. I have a
deadline
so I was hoping that someone could help me.
thx,
Cathy
Original
---------------------- CUT ---------------
|