Simple If-Else-statement to chose one cell over the other - excel - marco

[Tonx]

Hiiii,


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


<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; ">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 arrResultsEnd Sub</code></pre>​

 

[Michael M]

I'd suggest you change your tags from HTML tags to code tags
That way we can see the existing code in the correct format.
See my tag for using Code Tags

 

[Tonx]

Thank you. Here is it

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif;"> Sub test()Dim ws As WorksheetDim rngData As RangeDim DataCell As RangeDim arrResults() As VariantDim ResultIndex As LongDim strFolderPath As StringSet ws = Sheets("Sheet1")Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))If rngData.Row < 2 Then Exit Sub    'No dataReDim arrResults(1 To rngData.Rows.Count, 1 To 11)strFolderPath = ActiveWorkbook.Path & Application.PathSeparatorFor 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 sheetWith 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 = TrueEnd WithSet ws = NothingSet rngData = NothingSet DataCell = NothingErase arrResults</code></pre>End Sub