fill missing numbers

[vilas desai]

Dear Sirs,

Please refer to the attached worksheet
when I click the form button on MasterList! the data in cols H and I of JB_Sch should first get sorted in ascending order as shown and then the missing numbers shoud be inserted and the two coloumns to be reproduced in worksheet JB_term

Thanks in advance and best regards
Vilas Desai

[Rudi]

Do you want the missing data to be inserted into sheet JB_Sch also or only in sheet JB_term?
In which columns must the data be put into in sheet JB_term?

[vilas desai]

Only in JB_term

Regards
Vilas Desai

[Rudi]

And into which column in JB-term must the new data be put?

[vilas desai]

Col E, but I guess If I want a different col, I can change it myself.

[vilas desai]

Also I want the other col too in Col D of JB_term

[Rudi]

Give this a try....

fill_missing_nos.xlsm

[vilas desai]

Thank you, Rudi.
It works for the first time, but when I change the sequence od data in JB_Sch, and hit the button again, it gets hanged. Nothing happens and I have to use ctrl-alt-del keys to come out. And I get an error "
:Cannot Quit Microsoft Excel"

[HansV]

Here is a macro that is basically equivalent to Rudi's version, but with some constants at the beginning that you can modify to suit your setup.

Code: Select all

Sub SortAndInsert()
    Const lngFirstRow = 6 ' Start row of data
    Const lngSourceCol = 8 ' First column of data (H)
    Const lngTargetCol = 4 ' First column of sorted data (D)
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim lngLastRow As Long
    Dim lngRow As Long
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set wshSource = Worksheets("JB_Sch")
    Set wshTarget = Worksheets("JB_Term")
    wshTarget.Cells(1, lngTargetCol).Resize(, 2).EntireColumn.Clear
    lngLastRow = wshSource.Cells(wshSource.Rows.Count, lngSourceCol).End(xlUp).Row
    wshSource.Range(wshSource.Cells(lngFirstRow, lngSourceCol), _
        wshSource.Cells(lngLastRow, lngSourceCol + 1)).Copy _
        Destination:=wshTarget.Cells(lngFirstRow, lngTargetCol)
    wshTarget.Range(wshTarget.Cells(lngFirstRow, lngTargetCol), _
        wshTarget.Cells(lngLastRow, lngTargetCol + 1)).Sort _
        Key1:=wshTarget.Cells(lngFirstRow, lngTargetCol), _
        Key2:=wshTarget.Cells(lngFirstRow, lngTargetCol + 1)
    For lngRow = lngLastRow To lngFirstRow Step -1
        Do While wshTarget.Cells(lngRow, lngTargetCol).Value = _
                wshTarget.Cells(lngRow - 1, lngTargetCol).Value And _
                wshTarget.Cells(lngRow, lngTargetCol + 1).Value > _
                wshTarget.Cells(lngRow - 1, lngTargetCol + 1).Value + 1
            wshTarget.Cells(lngRow, lngTargetCol).EntireRow.Insert
            wshTarget.Cells(lngRow, lngTargetCol).Value = _
                wshTarget.Cells(lngRow - 1, lngTargetCol).Value
            wshTarget.Cells(lngRow, lngTargetCol + 1).Value = _
                wshTarget.Cells(lngRow + 1, lngTargetCol + 1).Value - 1
        Loop
    Next lngRow
ExitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[vilas desai]

Thank you, Hans and Rudi.
Hans, this works perfect.
Please advise me if I have to change the desctinaltion cols, where do I make the changes in the code. Is it in the code below or more?
Thanks and best regards
Vilas

Code: Select all

 wshTarget.Range(wshTarget.Cells(lngFirstRow, lngTargetCol), _
        wshTarget.Cells(lngLastRow, lngTargetCol + 1)).Sort _
        Key1:=wshTarget.Cells(lngFirstRow, lngTargetCol), _
        Key2:=wshTarget.Cells(lngFirstRow, lngTargetCol + 1)

[Rudi]

You just change the Const value at the top of the code:

Const lngTargetCol = 4 ' First column of sorted data (D)

To paste into column E in the destination, change the 4 to a 5 (fifth column)

Const lngTargetCol = 5 ' First column of sorted data (E)

[vilas desai]

Dear Rudi / Hans

Thanks for this code. The second col in source sheet JB_Sch has formulas referencing to another worksheet and so when when the copy is made to the target worksheet JB_term, I get errors (type mismatch) because the formulas cannot be evaluated. So I just want the values to be copied from Jn_Box to Jb_term. Further the copy in the destination sheet, please make it starting from Row 4 without the formatting (borders) and before the sort & copy is made the contents of the JB_Term should be cleared from row 3 to end of rows.

could you please help me with this/
Best regards
Vilas Desai

[Rudi]

Try this replacement macro...

Code: Select all

Sub SortAndInsert()
    Const lngFirstRow = 4 ' Start row of data
    Const lngSourceCol = 8 ' First column of data (H)
    Const lngTargetCol = 5 ' First column of sorted data (E)
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rTarget As Range
    Dim lngLastRow As Long
    Dim lngRow As Long
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set wshSource = Worksheets("JB_Sch")
    Set wshTarget = Worksheets("JB_Term")
    Set rTarget = wshTarget.Range(wshTarget.Cells(3, lngTargetCol), wshTarget.Cells(wshTarget.Columns(lngTargetCol).Cells.Count, lngTargetCol + 1))
    rTarget.Clear
    lngLastRow = wshSource.Cells(wshSource.Rows.Count, lngSourceCol).End(xlUp).Row
    wshSource.Range(wshSource.Cells(lngFirstRow, lngSourceCol), _
        wshSource.Cells(lngLastRow, lngSourceCol + 1)).Copy
        wshTarget.Cells(lngFirstRow, lngTargetCol).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        wshTarget.Cells(lngFirstRow, lngTargetCol).PasteSpecial Paste:=xlPasteValues
        With rTarget
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    wshTarget.Range(wshTarget.Cells(lngFirstRow, lngTargetCol), _
        wshTarget.Cells(lngLastRow, lngTargetCol + 1)).Sort _
        Key1:=wshTarget.Cells(lngFirstRow, lngTargetCol), _
        Key2:=wshTarget.Cells(lngFirstRow, lngTargetCol + 1)
    For lngRow = lngLastRow To lngFirstRow Step -1
        Do While wshTarget.Cells(lngRow, lngTargetCol).Value = _
                wshTarget.Cells(lngRow - 1, lngTargetCol).Value And _
                wshTarget.Cells(lngRow, lngTargetCol + 1).Value > _
                wshTarget.Cells(lngRow - 1, lngTargetCol + 1).Value + 1
            wshTarget.Cells(lngRow, lngTargetCol).EntireRow.Insert
            wshTarget.Cells(lngRow, lngTargetCol).Value = _
                wshTarget.Cells(lngRow - 1, lngTargetCol).Value
            wshTarget.Cells(lngRow, lngTargetCol + 1).Value = _
                wshTarget.Cells(lngRow + 1, lngTargetCol + 1).Value - 1
        Loop
    Next lngRow
ExitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub