Fixed-row criteria

**farrukh** · 2012-01-10 11:04

Hello,

Hi All,

I have a issue , i have 50 plus sheets in a work book each sheets contain dates in column B . I need that the code look to (main sheet) column B dates and adjust rows of all the sheets as like main sheet based on dates. suppose in main sheet the date 1/1/2009 is placed at B row 15 so code adjust the whole dates and rows of all the sheets as like the main sheet, if date 1/3/2009 is place in column B row no 20 then the code adjust all the worksheet dates and rows to row number 20.

Cheers

**sdckapr** · 2012-01-10 11:45

It is not clear to me what you want exactly. Could you attach a sample workbook of a before and after?

My preference would be, if the sheets are supposed to be sorted/linked in that manner is to put them all on the same worksheet, so that they can sorted/moved/copied all together.

Steve

**farrukh** · 2012-01-10 23:11

Sir Steve,

I have attached the before and after results , the problem in sorting in one sheet is i need to fixed the different sheet data to ( Data sheet ) . Thats why i want to sort or adjust the rows according to the master sheet. In sample i have deducted the sheet because there are so many

Sorry if i cannot understand well.

Thanks

**sdckapr** · 2012-01-11 12:19

Does this code do what you need (Test on a copy of your workbooks since it modifies and deletes sheets!)

Code:

Sub SortAll()
  Dim wMaster As Worksheet
  Dim wks As Worksheet
  Dim sWksName As String
  Dim wTemp As Worksheet
  Dim rDates As Range
  Dim rMasterDates As Range
  Dim iHeaderRow As Integer
  Dim iDateCol As Integer
  Dim lRow As Long
  Dim rCell As Range
  Dim i As Integer
  Application.ScreenUpdating = False
  
  'Define initial settings
  iHeaderRow = 2  'Header is in row 2
  iDateCol = 2    'Dates are in col 2 = B
  Set wMaster = Worksheets("Master_sheet")
  
  'set Date lookup range
  With wMaster
    Set rMasterDates = .Range(.Cells(1, iDateCol), _
      .Cells(.Rows.Count, iDateCol).End(xlUp))
  End With
  
  'loop through all worksheets
  For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
    Set wks = Worksheets(i)
    'Ignore Data and Master_sheet
    If wks.Name <> "Data" And _
      wks.Name <> wMaster.Name Then
      'create a new temp worksheets to move the rows
      'in case there is overlap
      sWksName = wks.Name
      Set wTemp = Worksheets.Add(before:=wks)
      With wks
        'copy header
        .Rows(iHeaderRow).Copy wTemp.Cells(iHeaderRow, 1)
        'get date range
        Set rDates = .Range(.Cells(iHeaderRow + 1, iDateCol), _
          .Cells(.Rows.Count, iDateCol).End(xlUp))
        'loop through date range
        For Each rCell In rDates
          If rCell  <> "" Then
            lRow = Application.WorksheetFunction. _
              Match(rCell, rMasterDates, 0)
            rCell.EntireRow.Copy wTemp.Cells(lRow, 1)
          End If
        Next
        'delete original wks
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
      End With
      'rename Temp
      wTemp.Name = sWksName
    End If
  Next
  
  Application.ScreenUpdating = True
  Set wMaster = Nothing
  Set wks = Nothing
  Set wTemp = Nothing
  Set rDates = Nothing
  Set rMasterDates = Nothing
  Set rCell = Nothing
End Sub

Steve

**farrukh** · 2012-01-12 12:23

Sir Steve,

The code was showing the syntax error in those lines in the code i have change line like below but when i run this it does not change the before.xls data ?

Please advise ?

Code:

'Ignore Data and Master_sheet
    If wks.Name = "Data" And _
    wks.Name = wMaster.Name Then

Code:

 'loop through date range
        For Each rCell In rDates
          If rCell = "" Then

Cheers

**sdckapr** · 2012-01-12 16:14

I don't know why the code was missing an item. I corrected the code. It is not an equal sign (=) that was missing, it was a not equal sign. The lines should be:

Code:

'Ignore Data and Master_sheet
    If wks.Name <> "Data" And _
    wks.Name <> wMaster.Name Then

and

Code:

'loop through date range
        For Each rCell In rDates
          If rCell <> "" Then

Steve

**farrukh** · 2012-01-13 08:30

Sir Steve,

Superb, Fantastic you have saved my time alot for creating this code.

Thank you

Regards,
Farrukh

**farrukh** · 2012-01-30 03:12

---

Thread: Fixed-row criteria

Thread Tools