Copy rows to new sheet based on date range selected on a form

**drewship** · 05-08-2009, 08:22 AM

This question originated here and is not solved yet: http://www.excelforum.com/excel-prog...ml#post2088802

but since I have done some additional work, I have additional questions so thought I needed to make a new thread.

I hope someone can help me with the below issues and VBA is perfectly fine. This spreadsheet must perform calculations for every line since new items are added every day, so VBA is probably better than copying formulas down every line of the spreadsheet:

With the press of a button, I need to be able to select a range of dates and copy all lines within the range to a seperate sheet with the desired name under the same headings they currently reside under. I have included some modified code that is being used in another spreadsheet that was created for me, but I do not pretent to understand all of it and I no longer work with the creator of the spreadsheet. How do I use a button to open the form for date selections and entering the name of the new sheet, and then use the start button on the form to begin the matching and copying to a new sheet? If there is an easier way I am all for that too.

Also, I need to keep a total of all items by month as well as a monthly and annual average of the Total Item Value on the FY09 tab. This will eventually produce another sheet when a button is pressed to submit as a report. I think part of this answer is in using the MONTH(serial_number) function but I can only get this to work for a single cell. I need to search the entire Distribution 'D' column, match all the months to the FY09 tab to the respective month, and calculate the totals and averages. I think SUMIF may also be needed as well but need the MONTH(serial_number)to work first. If there is a way to code all of this in VBA that would be fine as well.

I have a pivot table on Sheet1 where I am trying to get the totals and averages described above but I am not sure it can do what I need. In column 'B' I need the total number of each item as well as the total number of all items. I tried various formats and adding the totals from the Totals tab but I have not figured it out.

Thanks in advance,
Andrew

**Spreadsheet_Booster** · 05-08-2009, 08:56 AM

Hi! Andrew,

I suppose that iI might offer my help, however I get confused by your description of the problems as well as the process of the VBA code in you file. Do you have an IM tool such as Google Talk, so that I can know what exactly you want and maybe we can make it together~

if possible, contact liuchanghong2000$gmail.com (replace $ with @). I'll be glad if I can help you!

**drewship** · 05-11-2009, 07:59 AM

Thanks Spreadsheet_Booster, This is something for work so I do not have IM capability.

I have worked on it some more and hope someone can help with this code:

    On Error Resume Next
        ws2.Name = dtselect4
    On Error GoTo 0
        With ws1
    LR = .Range("A" & Rows.Count).End(xlUp).row
    .Rows("1:2").Copy Destination:=ws2.Range("A1")
    j = 2
    For i = 3 To LR
        With .Range("A" & i)
            If .Range("D") >= lodate And .Range("D") <= hidate Then
                j = j + 1
                .EntireRow.Copy
                ws2.Range("A" & j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
        End With
    Next i
End With
Application.CutCopyMode = False

In the uploaded example, I want to press the button on the Utilities tab, select dates from May 7th to May 11th, name the sheet, and press Start.

When Start is pressed, I want to copy the first 2 rows over as the header to a new sheet (which was named in the form) and then copy every row that has a date in column "D" that is between or equal to the dated selected in the form. In this case, the Example tab contains the desired output. All new tabs should be placed at the end.

The actual output was the test2 tab. Can someone help me tweak this?

Thanks,
Andrew

**drewship** · 05-11-2009, 02:57 PM

No takers for the last bit of code??

Here is something I found on the forum that seems to be more complicated (to me anyway) but I have been able to tweak it to at least start copying data from my Distribution sheet to a new sheet, test5 in this case.

Application.ScreenUpdating = False
Sheets("Distribution").Select
Set ws1 = ActiveSheet
LC = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
colName = Replace(Cells(1, LC).Address(0, 0), 1, "")
colName2 = Replace(Cells(1, LC + 2).Address(0, 0), 1, "")
Worksheets.Add(After:=ws1).Name = dtselect4
Set ws2 = ActiveSheet
ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 11).Value
'ws2.Range("A:L").Value = ws1.Range("A:L").Value
'With ws1
'  .Range("A1:" & colName & 1).Copy
'  With ws2.Range("A1:" & colName & 1)
'    ActiveSheet.Paste
'    .RowHeight = 75.75
'    Range("F1").Select
'  End With
'ws2.Range("A2:" & colName & 1).Value = ws1.Range("A2:" & colName & 11).Value
With ws1
  .Range("A2:" & colName & 1).Copy
  
  With ws2.Range("A2:" & colName & 1)
    ActiveSheet.Paste
    .RowHeight = 75.75
    Range("D3").Select
  End With
  LR = .Cells(Rows.Count, 1).End(xlUp).row
  ws1.Range(colName2 & 2).Formula = "=IF(D3>=lodate And D3<=hidate,""Copy"","""")"
  ws1.Range(colName2 & 2).Copy ws1.Range(colName2 & 3 & ":" & colName2 & LR)
  With ws1.Range(colName2 & 2 & ":" & colName2 & LR)
    .Value = .Value
  End With
  NR = 2
  With .Columns(LC + 2)
    Set c = .Find("Copy", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
      firstaddress = c.Address
      Do
        ws1.Range("A" & c.row & ":" & colName & c.row).Copy ws2.Range("A" & NR & ":" & colName & NR)
        Set c = .FindNext(c)
        NR = NR + 1
      Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
    
 
  End With
End With
'End With
ws2.Range("C2:C" & NR).WrapText = False
ws2.Range("A1:" & colName & NR).Columns.AutoFit
ws1.Range(colName2 & 2 & ":" & colName2 & LR).ClearContents
ws2.Select
Range("F1").Select
Application.ScreenUpdating = True

Some problems are that it is not copying the complete header, it included filters (don't need those), changes column 'L' on the Distribution tab (don't want to change anything on the Distribution tab), and is not copying the rows that meet the selected date range.

If anyone could help it would be greatly appreciated.

Thanks,
Andrew

**drewship** · 05-12-2009, 06:32 AM

Bump no response

**drewship** · 05-12-2009, 12:22 PM

Updated workbook attached. I have worked on this more and have cleaned up the code some. This is what I have:

Sub routine()
    ' routine to read spreadsheet(s)
    ' pull data from sheets and create report sheet

    Dim wrkbkname  As String
   
    Dim ws As Worksheet
    Dim rundate As Date
    
    Dim LR As Long, i As Long, j As Long
    
    Dim NR As Long, LC As Long
    Dim c As Range, firstaddress As String
    Dim rng As Range
    Dim colName As String, colName2 As String
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
  
    ' define scan range start date is midnight
    lodate = Format(dtselect1, "mm/dd/yyyy")
    hidate = Format(dtselect2, "mm/dd/yyyy")
  
    ActiveSheet.Range("A1:L60000").Select
   
    ' create tab(s) for report
    frmDateSelect.txtUpdate.Text = " Processing"
    DoEvents

    ' turn off error window on delete
    Application.DisplayAlerts = False


Application.ScreenUpdating = False
Sheets("Distribution").Select

Set ws1 = ActiveSheet

LC = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
colName = Replace(Cells(1, LC + 2).Address(0, 0), 1, "")
colName2 = Replace(Cells(1, LC + 2).Address(0, 0), 1, "")
Worksheets.Add(Before:=ws1).Name = dtselect4

Set ws2 = ActiveSheet
ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName & 11).Value

With ws1
  .Range("A2:" & colName & 1).Copy
  
  With ws2.Range("A2:" & colName & 1)
    ActiveSheet.Paste
    .RowHeight = 12
    Range("D3").Select
    
  End With
  
  LR = .Cells(Rows.Count, 1).End(xlUp).row + 1
  ws1.Range(colName2 & 2).Formula = "=IF(D3>=lodate And D3<=hidate,""Copy"","""")"
  ws1.Range(colName2 & 2).Copy ws1.Range(colName2 & 3 & ":" & colName2 & LR)
  
  With ws1.Range(colName2 & 2 & ":" & colName2 & LR)
    .Value = .Value
    
  End With
  
  NR = 2
  With .Columns(LC + 2)
  
    Set c = .Find("Copy", LookIn:=xlValues, lookat:=xlWhole)
    
    If Not c Is Nothing Then
    
      firstaddress = c.Address
      Do
      
        ws1.Range("A" & c.row & ":" & colName & c.row).Copy ws2.Range("A" & NR & ":" & colName & NR)
        
        Set c = .FindNext(c)
        NR = NR + 1
        
      Loop While Not c Is Nothing And c.Address <> firstaddress
      
    End If
  End With
End With

ws2.Range("C2:C" & NR).WrapText = False
ws2.Range("A1:" & colName & NR).Columns.AutoFit
ws1.Range(colName2 & 2 & ":" & colName2 & LR).ClearContents
ws2.Select
Range("F1").Select
Application.ScreenUpdating = True
    
    ' turn off error window on delete
    Application.DisplayAlerts = False
   
     ' put cursor back in a1
    ActiveSheet.Range("A1").Select
    
    Application.DisplayAlerts = True
    
    frmDateSelect.txtUpdate.Text = " Done...Finished Processing "
    DoEvents
    
End Sub

This will copy the 2 header lines to a new sheet with the name you input on the userform when the button on the Utilities tab is pressed. The 2 problems I am still having is that column 'L' data is deleted and shaded grey after the processing is complete, and none of the data within the dates selected on the userform is copied to the new sheet which should look like the Example Output sheet. Can anyone help me with this???

Thanks,
Andrew

Copy rows to new sheet based on date range selected on a form

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Copy rows to new sheet based on date range selected on a form

Re: Press a button to open form, total and average of items, pivot table

Re: Press a button to open form, total and average of items, pivot table

Re: Press a button to open form, total and average of items, pivot table

Re: Copy rows to new sheet based on date range selected on a form

Re: Copy rows to new sheet based on date range selected on a form

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions