View Single Post
 
Old 09-15-2013, 11:07 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Quote:
Originally Posted by jonpackbosoxfan View Post
Yes that date is correct

I dont know a lot about VBA code, so i may need lots of help putting this together. But thank you for any help that you can provide me.

Thank you,
Cool Here is a start. The workbook attached is a 2003 but you should be able to reconvert it no problem. I added a worksheet that will give your results. It gives you an inputbox to put in the date for either Wednesday or Saturday. It will then grab each amount and the name from column B into the new worksheet. This code does not contain any error handling so try it out first and let me know if it works and I can fine tune it if needed.


Here is the code for the workbook
Code:
Sub WedData()

' Macro recorded 9/15/2013 by JRErickson
'
Dim WedDate As Date
Dim WedColTot As Integer
Dim CurCol As String
Dim CurRange As String
Range("'Print Out'!y1:z500").ClearContents
Range("'Print Out'!b4").ClearContents
Range("'Print Out'!d3").ClearContents
Range("a1").Select
WedDate = InputBox("Please enter Wednesday date in proper format.", "Enter Date")
    Cells.Find(What:=WedDate, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Select
        CurCell = ActiveCell.Column
        y = 8
        For X = 1 To 104
        If ActiveCell.Value <> "" Then
        Range("'Print Out'!Z" & y) = ActiveCell.Value
        Range("'Print Out'!Y" & y) = Cells(y, 2)
        y = y + 1
        ActiveCell.Offset(1, 0).Select
        Else
        ActiveCell.Offset(1, 0).Select
        End If
        Next X
       
      Range("'Print Out'!b4").Value = WedDate
      Range("'Print Out'!d3").Value = "Wednesday"
      Range("a3").Select
      
        
        
      
        
        
        
   
        


        
End Sub



Sub SatData()



' Macro recorded 9/15/2013 by JRErickson
'
Dim SatDate As Date
Dim SatColTot As Integer
Dim CurCol As String
Dim CurRange As String
Range("'Print Out'!y1:z500").ClearContents
Range("'Print Out'!b4").ClearContents
Range("'Print Out'!d3").ClearContents
Range("a1").Select
SatDate = InputBox("Please enter Saturday date in proper format.", "Enter Date")
    Cells.Find(What:=SatDate, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Select
        CurCell = ActiveCell.Column
        y = 8
        For X = 1 To 179
        If ActiveCell.Value <> "" Then
        Range("'Print Out'!Z" & y) = ActiveCell.Value
        Range("'Print Out'!Y" & y) = Cells(y, 2)
        y = y + 1
        ActiveCell.Offset(1, 0).Select
        Else
        ActiveCell.Offset(1, 0).Select
        End If
        Next X
       
      Range("'Print Out'!b4").Value = SatDate
      Range("'Print Out'!d3").Value = "Saturday"
      Range("a3").Select

End Sub

This was fun.

Let me know what you think or if you have any questions.

Take care.
Attached Files
File Type: xls membership Project5.xls (135.5 KB, 20 views)
Reply With Quote