Need a repeating Macro to select rows from the spreadsheet based on changing column range.

[Poor Dave]

Need help please writing an Excel Macro from you professionals. My coding knowledge is through Word VBA but little to limited with Excel.

I have a report that is run each night that continually updates with additional data. I dump the report raw data into a spreadsheet each morning. Now I need to select and cut out all the rows out of the entire spreadsheet that contains the number ‘2’ in a column (say column ‘I’) and place in the next worksheet. Then after that is all separated out, I need the macro to go back and select all number ‘3’ rows from the same column, select the entire rows, cut from main spreadsheet, and place in the next successive worksheet. Then ‘4’, then ‘5’ then etc. I don’t have to move any data with a ‘1’. The column may have additional integer numbers added each night, so first nights data in column ‘I” may be from 1 to 8, then next night may be 1 to 22, then next night data from 1 to 15, etc.

I found code posted by another programmer to perform the selecting of all their rows that contain the letter ’G’ for their application, adapted for my first number ‘2’, but then can’t figure out how to loop it back to hunt for the next successive number ’3’, then ‘4’, then ‘5’, etc.

This is what I have so far. Works fine for the number ‘2’. Now I need the macro loop to repeat itself until no number is found. Fails on remaining selecting of rows. Can’t figure out how to bound this code into a loop for column ‘I’ with a number range of say 2 – 100.

Thanks for your help!!

Sub Test()

Dim i As Integer
For i = 2 To 100
Columns("I:I").Select
Dim a As Range
Dim rngA As Range
For Each a In Intersect(ActiveSheet.UsedRange, Columns("I"))
If a = i Then
If rngA Is Nothing Then Set rngA = a.EntireRow
Set rngA = Union(rngA, a.EntireRow)
End If
Next a
rngA.Select
Selection.Cut
Sheets.Add After:=ActiveSheet
Cells.Select
ActiveSheet.Paste
Sheets("WM200 - Work Order Material Rep").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Next i
End Sub
Raw data looks like this with about 50 more columns.

 

[HaHoBe]

Hi Poor Dave,

what about using AutoFilter:

Public Sub MrE_1229043_1702317()
' https://www.mrexcel.com/board/threads/need-a-repeating-macro-to-select-rows-from-the-spreadsheet-based-on-changing-column-range.1229043/
Dim lngCounter As Long
Dim wsMatRep As Worksheet

Set wsMatRep = Sheets("WM200 - Work Order Material Rep")

With wsMatRep
  For lngCounter = 2 To WorksheetFunction.Max(.Columns("I:I"))
    If .AutoFilterMode Then .ShowAllData
    With .Range("A1").CurrentRegion
      .AutoFilter Field:=9, Criteria1:=CStr(lngCounter)
      .SpecialCells(xlCellTypeVisible).Copy
      Worksheets.Add after:=Worksheets(Worksheets.Count)
      ActiveSheet.Paste
      ActiveSheet.Name = Format(Now, "yymmdd_hhmmss_") & Format(lngCounter, "000")
    End With
    .Range("A2", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column)). _
        SpecialCells(xlCellTypeVisible).Delete xlShiftUp
  Next lngCounter
  .AutoFilterMode = False
End With

Set wsMatRep = Nothing
End Sub

Ciao,
Holger

 

[Poor Dave]

Hi Poor Dave,

what about using AutoFilter:

Public Sub MrE_1229043_1702317()
' https://www.mrexcel.com/board/threads/need-a-repeating-macro-to-select-rows-from-the-spreadsheet-based-on-changing-column-range.1229043/
Dim lngCounter As Long
Dim wsMatRep As Worksheet

Set wsMatRep = Sheets("WM200 - Work Order Material Rep")

With wsMatRep
  For lngCounter = 2 To WorksheetFunction.Max(.Columns("I:I"))
    If .AutoFilterMode Then .ShowAllData
    With .Range("A1").CurrentRegion
      .AutoFilter Field:=9, Criteria1:=CStr(lngCounter)
      .SpecialCells(xlCellTypeVisible).Copy
      Worksheets.Add after:=Worksheets(Worksheets.Count)
      ActiveSheet.Paste
      ActiveSheet.Name = Format(Now, "yymmdd_hhmmss_") & Format(lngCounter, "000")
    End With
    .Range("A2", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column)). _
        SpecialCells(xlCellTypeVisible).Delete xlShiftUp
  Next lngCounter
  .AutoFilterMode = False
End With

Set wsMatRep = Nothing
End Sub

Ciao,
Holger

Thanks for the quick response. Did not think to filter the column first to the specific value. This code does what I need with one exception. Each range that is pasted onto each successive sheet always contains the first row with the number 1 from my column.

 

[HaHoBe]

Hi Poor Dave,

with the code supplied above each number must be found otherwise the header row in the source sheet would get deleted.

Update to the code to take care of only data range to be copied if exist omitting the headers:

Public Sub MrE_1229043_1702317Update()
' https://www.mrexcel.com/board/threads/need-a-repeating-macro-to-select-rows-from-the-spreadsheet-based-on-changing-column-range.1229043/
' Updated: 20230204
' Reason:  condition added: if number to search for isn't found, omitt adding an empty sheet and deleting the header row on the source sheet

Dim blnCont As Boolean
Dim lngCounter As Long
Dim wsMatRep As Worksheet

Set wsMatRep = Sheets("WM200 - Work Order Material Rep")

With wsMatRep
  For lngCounter = 2 To WorksheetFunction.Max(.Columns("I:I"))
    blnCont = False
    If .AutoFilterMode Then .ShowAllData
    With .Range("A1").CurrentRegion
      .AutoFilter Field:=9, Criteria1:=CStr(lngCounter)
      If wsMatRep.Cells(wsMatRep.Rows.Count, 1).End(xlUp).Row > 1 Then blnCont = True
      If blnCont = True Then
        wsMatRep.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Paste
        ActiveSheet.Name = Format(Now, "yymmdd_hhmmss_") & Format(lngCounter, "000")
      End If
    End With
    If blnCont Then .Range("A2", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, _
          .Cells(1, .Columns.Count).End(xlToLeft).Column)).SpecialCells(xlCellTypeVisible).Delete xlShiftUp
  Next lngCounter
  .AutoFilterMode = False
End With

Set wsMatRep = Nothing
End Sub

Ciao,
Holger

 

[Poor Dave]

Thank you again for the quick response. Works like a champ!

 

[Poor Dave]

Hi Poor Dave,

with the code supplied above each number must be found otherwise the header row in the source sheet would get deleted.

Update to the code to take care of only data range to be copied if exist omitting the headers:

Public Sub MrE_1229043_1702317Update()
' https://www.mrexcel.com/board/threads/need-a-repeating-macro-to-select-rows-from-the-spreadsheet-based-on-changing-column-range.1229043/
' Updated: 20230204
' Reason:  condition added: if number to search for isn't found, omitt adding an empty sheet and deleting the header row on the source sheet

Dim blnCont As Boolean
Dim lngCounter As Long
Dim wsMatRep As Worksheet

Set wsMatRep = Sheets("WM200 - Work Order Material Rep")

With wsMatRep
  For lngCounter = 2 To WorksheetFunction.Max(.Columns("I:I"))
    blnCont = False
    If .AutoFilterMode Then .ShowAllData
    With .Range("A1").CurrentRegion
      .AutoFilter Field:=9, Criteria1:=CStr(lngCounter)
      If wsMatRep.Cells(wsMatRep.Rows.Count, 1).End(xlUp).Row > 1 Then blnCont = True
      If blnCont = True Then
        wsMatRep.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Paste
        ActiveSheet.Name = Format(Now, "yymmdd_hhmmss_") & Format(lngCounter, "000")
      End If
    End With
    If blnCont Then .Range("A2", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, _
          .Cells(1, .Columns.Count).End(xlToLeft).Column)).SpecialCells(xlCellTypeVisible).Delete xlShiftUp
  Next lngCounter
  .AutoFilterMode = False
End With

Set wsMatRep = Nothing
End Sub

Ciao,
Holger

Thank you again for the quick response. Works like a champ!