Help with small fix needed

G

Guest

Hello,

This is Catherine again.

(e-mail address removed)

I need help with a simple loop (please see code between ****** at bottom)

I am using VB to read an Excel spreadsheet, format the sheet based on the
input, and then save it. I have most of the code, but am stuck with a loop.

Basically, there are Test Cases written in an Excel spreadsheet. There are
one or more Test Cases in each Workbook. Each Test Case is separated by TWO
blank lines. The logic is, when the VB script sees two empty lines, it looks
to see if the third line is blank. If it is blank, that means that there are
no more Test Cases left in that Workbook. If the third line is populated,
that means there is another Test Case left. (this is the loop that I need
help with)...

There may or may not be more "sheets" in the spreadsheet (meaning the tab
separted sheets at the bottom of Excel). If a sheet exists, there may be one
or more Test Case in it. This part seems to be taken care of already.

The same logic applies to the Test Cases in the subsequent sheet as before,
meaning that if there are multiple Test Cases, they are separated by 2 blank
lines.

If someone can help me with writing an "IF Then" statement or a "Loop" in
the code provided, it would REALLY help me out. Basically, the statement
should be "If there are 3 blanks lines, then exit if. If the third line is
NOT blank, then continue to process".

PLEASE SEE THE AREA OF CODE WITHIN STARS (********)

Here is the code:



Option Explicit
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 NewTest --
folderName = "C:\testsToBeImported"
masterWorkbookPath = "C:\masterWorkbook.xls"
Set masterWorkbook = Application.Workbooks.Open(masterWorkbookPath)
Set MasterWS = masterWorkbook.Worksheets("import")
fileName = Dir(folderName & "*.xls")
Do While fileName <> ""
currentWriteRow = 2
filePath = folderName & "\" & fileName
'MsgBox fileName
Set childWorkbook = Application.Workbooks.Open(filePath)
'Added to loop through all worksheets
'--------- Loop through Test Cases ---------------
For Each ChildWS In childWorkbook.Worksheets
With ChildWS
currentRow = 10

NewTest = 1

Worksheet header information goes here


'Added to loop through all Test sections

Do Until .Cells(currentRow, 3) = "" -- more logic (is null or
isblank)
-- testName = .Cells(currentRow, 3).Value
-- testDescription = "Objective: " & .Cells(2, 3).Value
-- testDescription = testDescription & Chr(13) & "Project: "
& .Cells(currentRow + 5, 4).Value --- contatenate here
-- testDescription = testDescription & Chr(13) & "Login Used:
" & .Cells(currentRow + 6, 4).Value
-- testDescription = testDescription & Chr(13) &
"Preconditions: " & .Cells(currentRow + 7, 4).Value
-- currentRow = currentRow + 10
NoMoreRows = False
WriteRow = False
stepName = 1
If NewTest = 1 then
testName = .Cells(currentRow, 3).Value
testDescription =
"Objective: " & .Cells(2, 3).Value
testDescription =
testDescription & Chr(13) & "Project: " & .Cells(currentRow + 5, 4).Value ---
contatenate here
testDescription =
testDescription & Chr(13) & "Login Used: " & .Cells(currentRow + 6, 4).Value
testDescription = testDescription & Chr(13) &
"Preconditions: " & .Cells(currentRow + 7, 4).Value

NewTest = 0
Endif
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"
(make variable test data) -- need to change
MasterWS.Cells(currentWriteRow, 2).Value = testName
- test data (constant for every step)
MasterWS.Cells(currentWriteRow, 3).Value =
testDescription - test data (constant for every step)
MasterWS.Cells(currentWriteRow, 4).Value = stepName
- step data
MasterWS.Cells(currentWriteRow, 5).Value =
StepDescription
MasterWS.Cells(currentWriteRow, 6).Value =
StepExpectedResults
-- currentRow = currentRow + 1
currentWriteRow = currentWriteRow + 1
stepName = stepName + 1
End If
'Jump the extra 2 lines to next test section
currentRow = currentRow + 1

*****************************************************
Counter here to end to track (if statement to see if 3 blank lines) then
exit worksheet
-- if next three rows blank

exit do
*****************************************************
Loop
End With -- ChildWS
Next
childWorkbook.Close True, filePath
fileName = Dir()
Loop
masterWorkbook.Save
masterWorkbook.Close True, masterWorkbookPath
MsgBox "Import Formating Complete"
End Sub
 
B

Bob Phillips

Maybe

If Application.COUNTA(Rows(currentRow).Resize(3)) = 0 Then Exit Do

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
B

Bob Phillips

What does that mean?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
G

Guest

Sorry Bob,

I should have been more clear. When I run the vbs, I get this error:

Line: 3
Char: 16
Error: Expected end of statement
Code: 80010401
Source: Microsoft VBScript compilation error


Option Explicit

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 NewTest As String

folderName = "C:\testsToBeImported"
masterWorkbookPath = "C:\masterWorkbook.xls"
Set masterWorkbook = Application.Workbooks.Open(masterWorkbookPath)
Set MasterWS = masterWorkbook.Worksheets("import")

fileName = Dir(folderName & "*.xls")
Do While fileName <> ""

currentWriteRow = 2
filePath = folderName & "\" & fileName
'MsgBox fileName
Set childWorkbook = Application.Workbooks.Open(filePath)
'***
'***Added to loop through all worksheets
'***


'--------- Loop through Test Cases ---------------
For Each ChildWS In childWorkbook.Worksheets
With ChildWS
currentRow = 10

NewTest = 1

'Worksheet header information goes here

'***
'***Added to loop through all Test sections
'***
Do Until .Cells(currentRow, 3) = "" Or (IsNull(currentRow)) Then
' testName = .Cells(currentRow, 3).Value
' testDescription = "Objective: " & .Cells(2, 3).Value
' testDescription = testDescription & Chr(13) & "Project: " &
..Cells(currentRow + 5, 4).Value ---

contatenate here
' testDescription = testDescription & Chr(13) & "Login Used:
" & .Cells(currentRow + 6, 4).Value
' testDescription = testDescription & Chr(13) &
"Preconditions: " & .Cells(currentRow + 7, 4).Value
' currentRow = currentRow + 10
NoMoreRows = False
WriteRow = False
stepName = 1
If NewTest = 1 Then
testName = .Cells(currentRow, 3).Value
testDescription =
"Objective: " & .Cells(2, 3).Value
testDescription =
testDescription & Chr(13) & "Project: " & .Cells(currentRow + 5, 4).Value '
contatenate here
testDescription =
testDescription & Chr(13) & "Login Used: " & .Cells(currentRow + 6, 4).Value
testDescription = testDescription & Chr(13) &
"Preconditions: " & .Cells(currentRow + 7, 4).Value

NewTest = 0
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"
'(make variable test data) need to change
MasterWS.Cells(currentWriteRow, 2).Value = testName
' test data (constant for every step)
MasterWS.Cells(currentWriteRow, 3).Value =
testDescription ' test data (constant for every step)
MasterWS.Cells(currentWriteRow, 4).Value = stepName
' step data
MasterWS.Cells(currentWriteRow, 5).Value =
StepDescription
MasterWS.Cells(currentWriteRow, 6).Value =
StepExpectedResults
'currentRow = currentRow + 1
currentWriteRow = currentWriteRow + 1
stepName = stepName + 1
End If

'Jump the extra 2 lines to next test section
currentRow = currentRow + 1

' *******Counter here to end to track (if statement to
see if 3 blank lines) then exit worksheet
'if next three rows blank
' exit do
If Application.CountA(Rows(currentRow).Resize(3)) = 0
Then Exit Do




Loop
End With ' ChildWS
Next

'--------- Loop throught Test Cases ---------------









childWorkbook.Close True, filePath
fileName = Dir()
Loop

masterWorkbook.Save
masterWorkbook.Close True, masterWorkbookPath
MsgBox "Import Formating Complete"

End Sub
 
B

Bob Phillips

This

If Application.CountA(Rows(currentRow).Resize(3)) = 0
Then Exit Do

should all be one line.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top