Message box to Fill in StartRow of data to be copied and Row Header in VBA

[Arsil Hadjar]

Dear Sirs,

I have copied the folowing module to combine all worksheets in my worbooks and it work perfectly..

All sheets have the same format and header (Copied from-https://www.rondebruin.nl/win/s3/win002.htm)

In the existing VBA module

• the startRow for data to be copied in each worksheets already define in the VBA (StartRow = 4)

Is it possible to input the StartRow using InputBox , after that the VBA will continued as usual

• The row header in first sheets already define as sh.Rows("1:3").

Is it possible to input row header using InputBox ?

Looking forward to having your further advice in this regards

Many thanks
Arsil Hadjar

[/FONT][/COLOR][COLOR=#000088][FONT=Verdana]Sub[/FONT][/COLOR][FONT=Verdana] CopyDataWithoutHeaders[/FONT][COLOR=#666600][FONT=Verdana]()[/FONT][/COLOR][/FONT][/COLOR]
<code>    [COLOR=#000088]Dim[/COLOR] sh [COLOR=#000088]As[/COLOR] Worksheet
    [COLOR=#000088]Dim[/COLOR] DestSh [COLOR=#000088]As[/COLOR] Worksheet
    [COLOR=#000088]Dim[/COLOR] Last [COLOR=#000088]As[/COLOR] [COLOR=#000088]Long[/COLOR]
    [COLOR=#000088]Dim[/COLOR] shLast [COLOR=#000088]As[/COLOR] [COLOR=#000088]Long[/COLOR]
    [COLOR=#000088]Dim[/COLOR] CopyRng [COLOR=#000088]As[/COLOR] Range
    [COLOR=#000088]Dim[/COLOR] StartRow [COLOR=#000088]As[/COLOR] [COLOR=#000088]Long[/COLOR]
    [COLOR=#000088]Dim[/COLOR] Input_StartRow [COLOR=#000088]As[/COLOR] Action

    [COLOR=#000088]With[/COLOR] Application
        [COLOR=#666600].[/COLOR]ScreenUpdating [COLOR=#666600]=[/COLOR] [COLOR=#006666]False[/COLOR]
        [COLOR=#666600].[/COLOR]EnableEvents [COLOR=#666600]=[/COLOR] [COLOR=#006666]False[/COLOR]
    [COLOR=#000088]End[/COLOR] [COLOR=#000088]With[/COLOR]

    [COLOR=#880000]' Delete the summary sheet if it exists.[/COLOR]
    Application[COLOR=#666600].[/COLOR]DisplayAlerts [COLOR=#666600]=[/COLOR] [COLOR=#006666]False[/COLOR]
    [COLOR=#000088]On[/COLOR] [COLOR=#000088]Error[/COLOR] [COLOR=#000088]Resume[/COLOR] [COLOR=#000088]Next[/COLOR]
    [COLOR=#880000]' ActiveWorkbook.Worksheets("RDBMergeSheet").Delete[/COLOR]
    ActiveWorkbook[COLOR=#666600].[/COLOR]Worksheets[COLOR=#666600]([/COLOR][COLOR=#008800]"Combined"[/COLOR][COLOR=#666600]).[/COLOR]Delete
    [COLOR=#000088]On[/COLOR] [COLOR=#000088]Error[/COLOR] [COLOR=#000088]GoTo[/COLOR] [COLOR=#006666]0[/COLOR]
    Application[COLOR=#666600].[/COLOR]DisplayAlerts [COLOR=#666600]=[/COLOR] [COLOR=#006666]True[/COLOR]

    [COLOR=#880000]' Add a new summary worksheet.[/COLOR]
    [COLOR=#000088]Set[/COLOR] DestSh [COLOR=#666600]=[/COLOR] ActiveWorkbook[COLOR=#666600].[/COLOR]Worksheets[COLOR=#666600].[/COLOR]Add
    [COLOR=#880000]'DestSh.Name = "RDBMergeSheet"[/COLOR]
    DestSh[COLOR=#666600].[/COLOR]Name [COLOR=#666600]=[/COLOR] [COLOR=#008800]"Combined"[/COLOR]

    [COLOR=#880000]' Fill in the start row.[/COLOR]
    StartRow [COLOR=#666600]=[/COLOR] [COLOR=#006666]4[/COLOR]

        [COLOR=#880000]' Loop through all worksheets and copy the data to the[/COLOR]
    [COLOR=#880000]' summary worksheet.[/COLOR]
    [COLOR=#000088]For[/COLOR] [COLOR=#000088]Each[/COLOR] sh [COLOR=#000088]In[/COLOR] ActiveWorkbook[COLOR=#666600].[/COLOR]Worksheets
        [COLOR=#000088]If[/COLOR] sh[COLOR=#666600].[/COLOR]Name [COLOR=#666600]<>[/COLOR] DestSh[COLOR=#666600].[/COLOR]Name [COLOR=#000088]Then[/COLOR]
        [COLOR=#880000]'Copy header row, change the range if you use more columns[/COLOR]
        [COLOR=#000088]If[/COLOR] WorksheetFunction[COLOR=#666600].[/COLOR]CountA[COLOR=#666600]([/COLOR]DestSh[COLOR=#666600].[/COLOR]UsedRange[COLOR=#666600])[/COLOR] [COLOR=#666600]=[/COLOR] [COLOR=#006666]0[/COLOR] [COLOR=#000088]Then[/COLOR]
      [COLOR=#880000]'  sh.Range("A1:Z1").Copy DestSh.Range("A1")[/COLOR]
        sh[COLOR=#666600].[/COLOR]Rows[COLOR=#666600]([/COLOR][COLOR=#008800]"1:3"[/COLOR][COLOR=#666600]).[/COLOR]Copy DestSh[COLOR=#666600].[/COLOR]Rows[COLOR=#666600]([/COLOR][COLOR=#008800]"1:3"[/COLOR][COLOR=#666600])[/COLOR]

        [COLOR=#000088]End[/COLOR] [COLOR=#000088]If[/COLOR]

            [COLOR=#880000]' Find the last row with data on the summary[/COLOR]
            [COLOR=#880000]' and source worksheets.[/COLOR]
            Last [COLOR=#666600]=[/COLOR] LastRow[COLOR=#666600]([/COLOR]DestSh[COLOR=#666600])[/COLOR]
            shLast [COLOR=#666600]=[/COLOR] LastRow[COLOR=#666600]([/COLOR]sh[COLOR=#666600])[/COLOR]

            [COLOR=#880000]' If source worksheet is not empty and if the last[/COLOR]
            [COLOR=#880000]' row >= StartRow, copy the range.[/COLOR]
            [COLOR=#000088]If[/COLOR] shLast [COLOR=#666600]>[/COLOR] [COLOR=#006666]0[/COLOR] [COLOR=#000088]And[/COLOR] shLast [COLOR=#666600]>=[/COLOR] StartRow [COLOR=#000088]Then[/COLOR]
                [COLOR=#880000]'Set the range that you want to copy[/COLOR]
                [COLOR=#000088]Set[/COLOR] CopyRng [COLOR=#666600]=[/COLOR] sh[COLOR=#666600].[/COLOR]Range[COLOR=#666600]([/COLOR]sh[COLOR=#666600].[/COLOR]Rows[COLOR=#666600]([/COLOR]StartRow[COLOR=#666600]),[/COLOR] sh[COLOR=#666600].[/COLOR]Rows[COLOR=#666600]([/COLOR]shLast[COLOR=#666600]))[/COLOR]

               [COLOR=#880000]' Test to see whether there are enough rows in the summary[/COLOR]
               [COLOR=#880000]' worksheet to copy all the data.[/COLOR]
                [COLOR=#000088]If[/COLOR] Last [COLOR=#666600]+[/COLOR] CopyRng[COLOR=#666600].[/COLOR]Rows[COLOR=#666600].[/COLOR]Count [COLOR=#666600]>[/COLOR] DestSh[COLOR=#666600].[/COLOR]Rows[COLOR=#666600].[/COLOR]Count [COLOR=#000088]Then[/COLOR]
                   MsgBox [COLOR=#008800]"There are not enough rows in the "[/COLOR] [COLOR=#666600]&[/COLOR] _
                   [COLOR=#008800]"summary worksheet to place the data."[/COLOR]
                   [COLOR=#000088]GoTo[/COLOR] ExitTheSub
                [COLOR=#000088]End[/COLOR] [COLOR=#000088]If[/COLOR]

                [COLOR=#880000]' This statement copies values and formats.[/COLOR]
                CopyRng[COLOR=#666600].[/COLOR]Copy
                [COLOR=#000088]With[/COLOR] DestSh[COLOR=#666600].[/COLOR]Cells[COLOR=#666600]([/COLOR]Last [COLOR=#666600]+[/COLOR] [COLOR=#006666]1[/COLOR][COLOR=#666600],[/COLOR] [COLOR=#008800]"A"[/COLOR][COLOR=#666600])[/COLOR]
                    [COLOR=#666600].[/COLOR]PasteSpecial xlPasteValues
                    [COLOR=#666600].[/COLOR]PasteSpecial xlPasteFormats
                    Application[COLOR=#666600].[/COLOR]CutCopyMode [COLOR=#666600]=[/COLOR] [COLOR=#006666]False[/COLOR]
                [COLOR=#000088]End[/COLOR] [COLOR=#000088]With[/COLOR]

            [COLOR=#000088]End[/COLOR] [COLOR=#000088]If[/COLOR]

        [COLOR=#000088]End[/COLOR] [COLOR=#000088]If[/COLOR]
    [COLOR=#000088]Next[/COLOR]

ExitTheSub[COLOR=#666600]:[/COLOR]

    Application[COLOR=#666600].[/COLOR][COLOR=#000088]Goto[/COLOR] DestSh[COLOR=#666600].[/COLOR]Cells[COLOR=#666600]([/COLOR][COLOR=#006666]1[/COLOR][COLOR=#666600])[/COLOR]

    [COLOR=#880000]' AutoFit the column width in the summary sheet.[/COLOR]
    DestSh[COLOR=#666600].[/COLOR]Columns[COLOR=#666600].[/COLOR]AutoFit

    [COLOR=#000088]With[/COLOR] Application
        [COLOR=#666600].[/COLOR]ScreenUpdating [COLOR=#666600]=[/COLOR] [COLOR=#006666]True[/COLOR]
        [COLOR=#666600].[/COLOR]EnableEvents [COLOR=#666600]=[/COLOR] [COLOR=#006666]True[/COLOR]
    [COLOR=#000088]End[/COLOR] [COLOR=#000088]With[/COLOR] 
End[COLOR=#000088][FONT=Verdana]Sub
[COLOR=#000000][FONT=Arial]
Function LastRow(sh As Worksheet)[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]    On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]    LastRow = sh.Cells.Find(What:="*", _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            After:=sh.Range("A1"), _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            Lookat:=xlPart, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            LookIn:=xlFormulas, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            SearchOrder:=xlByRows, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            SearchDirection:=xlPrevious, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            MatchCase:=False).Row[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]    On Error GoTo 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]End Function[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]Function LastCol(sh As Worksheet)[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]    On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]    LastCol = sh.Cells.Find(What:="*", _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            After:=sh.Range("A1"), _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            Lookat:=xlPart, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            LookIn:=xlFormulas, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            SearchOrder:=xlByColumns, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            SearchDirection:=xlPrevious, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]                            MatchCase:=False).Column[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]    On Error GoTo 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]End Function[/FONT][/COLOR]


[/FONT][/COLOR]</code>[COLOR=#000000][FONT=Arial][COLOR=#333333][FONT=Verdana][/code[/FONT][/COLOR][/FONT][/COLOR]

 

[Dryver14]

you could replace StartRow = 4 with

StartRow = InputBox("Which Row would you like to start on", "StartRow indicator")

I am not sure what kind of error handling you would like to put with this.

 

[Arsil Hadjar]

you could replace StartRow = 4 with

StartRow = InputBox("Which Row would you like to start on", "StartRow indicator")

I am not sure what kind of error handling you would like to put with this.

Dear Dryver14,
Many thanks for the suggestion
Best Regards
Arsil Hadjar