VBA macro: insert row if condition is met and apply formulae

[CXsjr]

Good morning folks,

I'm new here and have only 'google level' experience of VBA, and although I usually manage to cobble together a code to get it to do what I want, this time I'm really struggling.

I have a huge set of data relating to past travels which I want to convert each time I export the data to another workbook. I've included a picture of how the data currently looks, and how I would like it to look once I've run the VBA code.

The data lists hundreds of journeys. Some journeys were direct, but some journeys are "from A to C via B" etc.

I'm looking for VBA that will count the rows, then cycle through each row of data and where there is an entry in the via field (column F in this instance), it will insert a row below this, copy all of the data from Columns A, B and C then essentially manipulate the data in columns D, E and F.

As an example: a record for a journey from D to E via F, will become two records, one from D to F, the second from F to E.

I'm guessing the latter part of the code will involve using "activecell.value" and "offset" but try as I might, I just can't get it to work. I've had success with inserting rows based on criteria before, but I simply can't pull together inserting rows and manipulating the data.

The top row contains column headings.

I hope this all makes sense although I'll be more than happy to provide further explanations if needed.

I'd really appreciate any assistance that anyone can offer, and my sincerest thanks in advance for taking the time out of your day to help if you can.

Best regards, Stu

 

[DanteAmor]

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

I assume your data starts in cell A2.
The results will start in cell H2.

Try this:

Sub InsertRow()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("A2:F" & Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1) + WorksheetFunction.CountA(Range("F:F")), 1 To UBound(a, 2))
  
  For i = 1 To UBound(a, 1)
    If a(i, 6) = "" Then
      'If the cell in F is empty, then simply pass the data.
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    Else
      'If cell F has data then create 2 records
      
      'Record 1
      k = k + 1
      For j = 1 To 4
        b(k, j) = a(i, j)
      Next
      b(k, 5) = a(i, 6)       'change To by Via
      
      'Record 2
      k = k + 1
      For j = 1 To 3
        b(k, j) = a(i, j)
      Next
      b(k, 4) = a(i, 6)       'change From by Via
      b(k, 5) = a(i, 5)       'change To by From
    End If
  Next
  
  Range("H2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

I added some notes in the macro to explain a bit what the code does.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[CXsjr]

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

I assume your data starts in cell A2.
The results will start in cell H2.

Try this:

Sub InsertRow()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
 
  a = Range("A2:F" & Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1) + WorksheetFunction.CountA(Range("F:F")), 1 To UBound(a, 2))
 
  For i = 1 To UBound(a, 1)
    If a(i, 6) = "" Then
      'If the cell in F is empty, then simply pass the data.
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    Else
      'If cell F has data then create 2 records
     
      'Record 1
      k = k + 1
      For j = 1 To 4
        b(k, j) = a(i, j)
      Next
      b(k, 5) = a(i, 6)       'change To by Via
     
      'Record 2
      k = k + 1
      For j = 1 To 3
        b(k, j) = a(i, j)
      Next
      b(k, 4) = a(i, 6)       'change From by Via
      b(k, 5) = a(i, 5)       'change To by From
    End If
  Next
 
  Range("H2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

I added some notes in the macro to explain a bit what the code does.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

A million thanks - I’m working until late tonight but I’ll try it in the morning; in the meantime, I really appreciate your help. I’ll keep you posted!

 

[CXsjr]

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

I assume your data starts in cell A2.
The results will start in cell H2.

Try this:

Sub InsertRow()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
 
  a = Range("A2:F" & Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1) + WorksheetFunction.CountA(Range("F:F")), 1 To UBound(a, 2))
 
  For i = 1 To UBound(a, 1)
    If a(i, 6) = "" Then
      'If the cell in F is empty, then simply pass the data.
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    Else
      'If cell F has data then create 2 records
     
      'Record 1
      k = k + 1
      For j = 1 To 4
        b(k, j) = a(i, j)
      Next
      b(k, 5) = a(i, 6)       'change To by Via
     
      'Record 2
      k = k + 1
      For j = 1 To 3
        b(k, j) = a(i, j)
      Next
      b(k, 4) = a(i, 6)       'change From by Via
      b(k, 5) = a(i, 5)       'change To by From
    End If
  Next
 
  Range("H2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

I added some notes in the macro to explain a bit what the code does.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

This worked perfectly ... thank you so much, I am extremely appreciative!