Previous Topic Next Topic

Macro to insert rows in a spreadsheet

Closed
Cobs - Mar 20, 2012 at 05:56 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Mar 25, 2012 at 07:32 AM
Hello,

I hope someone here can help. I'm looking for a simple macro to insert a row in an exported excel file every time the value (text and numbers) differs in any of a selection of columns.

Basically the data is a large spreadsheet that contains a list of a fleet of vehicles with different years, makes, models and series' (YMMS). The data is already pre sorted by those values (i.e. all 2011 Chevy Impala LS will be together) I just need to put insert a line when the list goes from the 2011 impala LS to the 2012 Imapla LS.

As for how the data looks; The year is in Column B, the make is in Column C, the model is in column D and the series in column E (column A is an internal value that changes for each vehicle).

2011 Chevy Impala LS
2011 Chevy Impala LS
2011 Chevy Impala LS
2011 Chevy Impala LS<---- I would want a row inserted after this row
2012 Chevy Impala LS
2012 Chevy Impala LS

2012 Chevy Impala LS
2012 Chevy Impala LS<--- I would want a row inserted after this row
2011 Chevy Traverse LS

I hope this is enough info to go on. If there are any questions let me know. I have different years makes models and series of all types so I would need a row if values were different in any column.

Thanks in advance.

1 response

Answer 1 / 1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 25, 2012 at 07:32 AM
try this. The main macro is "insertBlankRows" 

Option Explicit

Public Sub insertBlankRows()

   Dim lastRow          As Long
   Dim dataFirstRow     As Long
   Dim scanCol          As Variant
   Dim counter          As Integer
   Dim changedRow       As Boolean
   
   ' the last used row in column A
   lastRow = getItemLocation("*", Cells)
   
   'location of first data row
   dataFirstRow = 2
   
   'columns to be scanned
   scanCol = Array("B", "C", "D", "E")
   
   Do While lastRow > dataFirstRow
      changedRow = False
      For counter = 0 To UBound(scanCol)
      
         'is value different from row above
         If (Cells(lastRow, scanCol(counter)) <> Cells(lastRow - 1, scanCol(counter))) _
         Then
            'it is different
            changedRow = True
            Exit For
         End If
      Next
      
      If (changedRow) _
      Then
         Rows(lastRow).Insert
      End If
      lastRow = lastRow - 1
   Loop
   
End Sub

Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function
1