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>
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>
Last edited: