Friday, 23 August 2013

Simple IF statement excel vba

Simple IF statement excel vba

I have the following code below and what it does it create another excel
document from the information gathered from the initial document (source).
So what i want to do now is create a statement that will do some checking
for me:
If column E and F has values, then i want to take F value If E is blank i
want to take F value If F is blank i want to take E value
I want the final value to only display in column K in the new document
workbook
Keep in mind that column E and F is in the source document
Please help, thank you
Sub test()
Dim ws As Worksheet
Dim rngData As Range
Dim DataCell As Range
Dim arrResults() As Variant
Dim ResultIndex As Long
Dim strFolderPath As String
Set ws = Sheets("Sheet1")
Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
If rngData.Row < 2 Then Exit Sub 'No data
ReDim arrResults(1 To rngData.Rows.Count, 1 To 11)
strFolderPath = ActiveWorkbook.Path & Application.PathSeparator
For Each DataCell In rngData.Cells
ResultIndex = ResultIndex + 1
Select Case (Len(ws.Cells(DataCell.Row, "B").Text) > 0)
Case True: arrResults(ResultIndex, 1) = "" &
ws.Cells(DataCell.Row, "B").Text & ""
Case Else: arrResults(ResultIndex, 1) = "" &
ws.Cells(DataCell.Row, "A").Text & ""
End Select
arrResults(ResultIndex, 2) = "" & ws.Cells(DataCell.Row, "B").Text & ""
arrResults(ResultIndex, 3) = "animals/type/" & DataCell.Text &
"/option/an_" & DataCell.Text & "_co.png"
arrResults(ResultIndex, 4) = "animals/" & DataCell.Text &
"/option/an_" & DataCell.Text & "_co2.png"
arrResults(ResultIndex, 5) = "animals/" & DataCell.Text & "/shade/an_"
& DataCell.Text & "_shade.png"
arrResults(ResultIndex, 6) = "animals/" & DataCell.Text & "/shade/an_"
& DataCell.Text & "_shade2.png"
arrResults(ResultIndex, 7) = "animals/" & DataCell.Text & "/shade/an_"
& DataCell.Text & "_shade.png"
arrResults(ResultIndex, 8) = "animals/" & DataCell.Text & "/shade/an_"
& DataCell.Text & "_shade2.png"
arrResults(ResultIndex, 9) = "" & ws.Cells(DataCell.Row, "C").Text & ""
arrResults(ResultIndex, 10) = "" & ws.Cells(DataCell.Row, "D").Text & ""
arrResults(ResultIndex, 11) = "" & ws.Cells(DataCell.Row, "E").Text & ""
Next DataCell
'Add a new sheet
With Sheets.Add
Sheets("Sheet2").Rows(1).Copy .Range("A1")
.Range("A2").Resize(ResultIndex, UBound(arrResults, 2)).Value =
arrResults
'.UsedRange.EntireRow.AutoFit 'Uncomment this line if desired
'The .Move will move this sheet to its own workook
.Move
'Save the workbook, turning off DisplayAlerts will suppress prompt to
override existing file
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs strFolderPath & "destin.xls", xlExcel8
Application.DisplayAlerts = True
End With
Set ws = Nothing
Set rngData = Nothing
Set DataCell = Nothing
Erase arrResults
End Sub

No comments:

Post a Comment