Time range cell selection change

[MikeWaller]

Hello,

I tried to look for a previous thread concerning this and I am not able to find anything, so hopefully this hasn't already been asked. I have a production report that uses time ranges to fill data, and the time ranges are in column 16. I need to pull the data from each hour, and I want to set the range between the hour in B16 and C16, C16 and D16 etc. and then post the data in the relevant cells in that column. My main question is how to have the code treat every range seperately instead of having to create a sub for each. Here is what I have so far:

'Create Query
   sSQL = "SELECT CAST(CSN as varchar(25)) as CSN, CAST(VIN as varchar(25)) as VIN, ContID, ProcDefName, ProcStateStart, ProcStateEnd, ProcGrpName, ProcStateUserID"
   sSQL = sSQL & " FROM vblReportIMProcStateWithContAttrib"

'   Start CSN is in B2 on Run Worksheet
   dtStartDate = Worksheets("MON PROD").Cells(16, 3)
'   End CSN is in B3 on Run Worksheet
   dtEndDate = Worksheets("MON PROD").Cells(16, 4)
   
   
   If dtStartDate <> #12:00:00 AM# Then
      If dtEndDate <> #12:00:00 AM# Then 'apply both
         sSQL = sSQL & " WHERE ProcStateEnd >= '" & dtStartDate & "' AND ProcStateEnd <= '" & dtEndDate & "'"
      Else 'apply just start
         sSQL = sSQL & " WHERE ProcStateEnd = '" & dtStartDate & "'"
      End If

dtStartDate and dtEndDate are the values that need to change for each hour, and for the most part they will just go down the row one by one(C16-N16, P16-AA16)

I am relatively new to VBA programming, any help or explanation would be greatly appreciated.

Thank you very much.

[MikeWaller]

I forgot to mention that I also need this done on 5 other worksheets, "MON PROD", "TUES PROD", "WED PROD", THURS PROD", "FRI PROD" and "SAT PROD". Is there any way to do this from one line of code, or does it have to be done for each sheet? I am trying to make all of the querys happen at the press of a single button.

[rkey]

Hi Mike,

You can run your code with a loop, and use the loopnumber to fill the columnnumber used in the cells function.
You should also use it in the displaying of the data, otherwise it will overwrite eachother.
I assume there is another part of the code?
If not, where do you want the output pasted for e.g. the start/end B16/C16

[MikeWaller]

There is more code, but I am editing it from a previous spreadsheet so most of it really isn't relavant right now. I need to get the amount of units produced per hour, and to do this I was going to subtract the last unit in one hour from the last unit in the next and then post the difference to the 10th row in that column. I understand this is probably hard to understand without seeing the rest of the code, so I will work on getting the loop in place and then post the rest.

[rkey]

Hi Mike,

Try something like this then

'Loop for each sheet where sheet name ends with PROD
For Each ws In Worksheets
    If Right(ws.Name, 4) = "PROD" Then
        'Determine last column filled with data on row 16
            LastCol = ws.Cells(16, .Columns.Count).End(xlToLeft).Column
            If LastCol < 4 Then LastCol = 4
            
            'Start loop
            For c = 4 To LastCol
            'Create Query
           sSQL = "SELECT CAST(CSN as varchar(25)) as CSN, CAST(VIN as varchar(25)) as VIN, ContID, ProcDefName, ProcStateStart, ProcStateEnd, ProcGrpName, ProcStateUserID"
           sSQL = sSQL & " FROM vblReportIMProcStateWithContAttrib"
        
        '   Start CSN is in B2 on Run Worksheet
           dtStartDate = ws.Cells(16, LastCol - 1)
        '   End CSN is in B3 on Run Worksheet
           dtEndDate = ws.Cells(16, LastCol)
           
           
           If dtStartDate <> #12:00:00 AM# Then
              If dtEndDate <> #12:00:00 AM# Then 'apply both
                 sSQL = sSQL & " WHERE ProcStateEnd >= '" & dtStartDate & "' AND ProcStateEnd <= '" & dtEndDate & "'"
              Else 'apply just start
                 sSQL = sSQL & " WHERE ProcStateEnd = '" & dtStartDate & "'"
              End If
             
           'Paste result to ws.Cells(10, LastCol)
            
           Next c 'End loop
           
    End If
Next

[MikeWaller]

I just realized there are two "next" statements, but removing either doesn't help.

[MikeWaller]

And this is the code that fills the data. I need this to spread the data from the previous code accross column 10.

Private Sub FillSheet()
   
   On Error GoTo ERROR_TRAP
   
   Dim ws As Worksheet
   Dim nRow As Integer     'Column
   Dim nCol As Integer     'Row
   Dim sCSN As String      'CSN
   Dim sVIN As String      'VIN
   Dim sStation As String
   Dim sProcessGroup As String
   Dim sCSNold As String
   Dim sCSNnew As String
   Dim sCSNInput As String
   Dim sWIP As String
   Dim sUserID As String
   Dim nCount As Integer   'Unique CSN Count
   Dim nLoop As Integer
   Dim ShiftStart As Date
   Dim sDateEnd As String
   Dim sStartTime As String
   Dim nRowStart As Integer
   Dim nColStart As Integer
   Dim ProcStateUserID As String
   
   Dim bDateDisplayed As Boolean

   Set ws = ThisWorkbook.Worksheets(9)
   
   'Deactivate Automatic Worksheet Recalculation
   Application.Calculation = xlCalculationManual
   
   nRowStart = 1
   nColStart = 3
   
   'Display Status
   Me.Cells(3, 6) = "Initialize Sheet"
   ShiftStart = Worksheets("Run Report").Cells(4, 2)
   
   sProcessGroup = moRSWips!ProcGrpName
   
   
   
   'Get Distinct Column Count
   nCount = 0
   While Not moRSWips.EOF
      If sCSN <> moRSWips!CSN Then
         sCSN = moRSWips!CSN
          
            If (moRSWips!ProcGrpName = "CradleBatchAssy") Or (moRSWips!ProcGrpName = "PowerTrainSTSV") Or (moRSWips!ProcGrpName = "StaBarAssyBatch") Then
               sCSN = moRSWips!VIN & ""
            End If
         
         
        'Increment Column Counter
         nCount = nCount + 1
      End If
      'Get Next Record
      moRSWips.MoveNext
   Wend
   If Not moRSWips.BOF Then
      moRSWips.MoveFirst
   End If
   
   'Clear Old Data
   ClearWorksheet
   
   'Clear First Column
   ws.Range("B2:D2") = ""
   ws.Range("A2:D2") = ""
   
   'Fill Data
   If nCount > 0 Then
   
      'Display Status
      Me.Cells(3, 6) = "Create Grid"
   
      
      'Display Status
      Me.Cells(3, 6) = "Fill Data"
      
      nRow = nRowStart - 1
      While Not moRSWips.EOF
         sCSN = moRSWips!CSN & ""
         
            If (moRSWips!ProcGrpName = "CradleBatchAssy") Or (moRSWips!ProcGrpName = "PowerTrainSTSV") Or (moRSWips!ProcGrpName = "StaBarAssyBatch") Then
               sCSN = moRSWips!VIN & ""
            End If
         
         
         
         
         sUserID = moRSWips!ProcStateUserID & ""
         sWIP = moRSWips!ContID & ""
         sStartTime = moRSWips!ProcStateStart & ""
         sCSNnew = sCSN & sWIP & sStation & sUserID
         While Not (sCSNold = sCSNnew)
            If Not (sCSNold = sCSNnew) Then
               'First Record with NEW CSN
               
               'Increment Row Counter
               nRow = nRow + 1
               
               'Display CSN
               ws.Cells(nRow, 1) = sCSN
               ws.Cells(nRow, 5) = sStartTime
               ws.Cells(nRow, 6) = nCount
               
                   If Not bDateDisplayed Then
                  'Display First CSN ProcStateEnd
                  ws.Cells(6, 2) = sDateEnd
                  bDateDisplayed = True
               End If
            
            End If
            
            'Make OLD Copies
            sCSNold = sCSN & sVIN & sWIP & sStation & sUserID
         
         Wend
         
         
         'Get Next Record
         moRSWips.MoveNext
      Wend
      
   'Display Status
   Me.Cells(3, 6) = "Format Data"
        
   'ReActivate Automatic Worksheet Recalculation
   Application.Calculation = xlCalculationAutomatic
      
Format_Cells:
   
      
      'Display Status
      Me.Cells(3, 6) = "Sheet Filled"
      Me.Cells(4, 6) = Now

   End If

EXIT_SUB:
   Exit Sub

ERROR_TRAP:
   Select Case Err.Number
   Case 0
   Case Else
      DisplayError msModName & "FillSheet", Err.Number, True, Err.Description
      Err.Clear
      Resume EXIT_SUB
   End Select
   
End Sub

Thanks for any help. There is more to it, but I think that once I can figure out how to loop all of this the rest will be easy.

[MikeWaller]

Thanks for your quick reply. I've had a lot of time off and a lot of other projects going on so I am just getting back to this. I am having trouble with the loop. I didn't give you all of the code that I should have. It is telling me that there is a next without for, but as far as I can tell it should be working. Any suggestions?

Private Function GetData() As Boolean
   
   On Error GoTo ERROR_TRAP
   
   Dim sStartCSN     As String
   Dim sEndCSN       As String
   Dim dtStartDate   As String
   Dim dtEndDate     As String
   Dim sSQL          As String
   Dim ProcStateUserID As String
   
   Dim ws As Worksheet
   Dim LastCol As Integer
   Dim c As Integer
   
   
     'Loop for each sheet where sheet name ends with PROD For Each ws In Worksheets
    If Right(ws.Name, 4) = "PROD" Then
        'Determine last column filled with data on row 16
            LastCol = ws.Cells(16, Columns.Count).End(xlToLeft).Column
            If LastCol < 4 Then LastCol = 4

   'Display Status
   ws.Cells(3, 6) = "Getting Data"
   
   GetData = False

'Start loop
For c = 4 To LastCol

   'Create Query
   sSQL = "SELECT CAST(CSN as varchar(25)) as CSN, CAST(VIN as varchar(25)) as VIN, ContID, ProcDefName, ProcStateStart, ProcStateEnd, ProcGrpName, ProcStateUserID"
   sSQL = sSQL & " FROM vblReportIMProcStateWithContAttrib"

   
    '   Start CSN is in Row 16 on Run Worksheet
        dtStartDate = ws.Cells(16, LastCol - 1)
    '   End CSN is in Row 16 on Run Worksheet
        dtEndDate = ws.Cells(16, LastCol)
      
   If dtStartDate <> #12:00:00 AM# Then
      If dtEndDate <> #12:00:00 AM# Then 'apply both
         sSQL = sSQL & " WHERE ProcStateEnd >= '" & dtStartDate & "' AND ProcStateEnd <= '" & dtEndDate & "'"
      Else 'apply just start
         sSQL = sSQL & " WHERE ProcStateEnd = '" & dtStartDate & "'"
      End If
    
       sSQL = sSQL & " AND ProcGrpName in ('FrontSuspension')"
      sSQL = sSQL & " AND ProcStateComp = 'YES'"
      sSQL = sSQL & " AND ProcStateTranType = 'Completed'"
      sSQL = sSQL & " AND ProcDefName <> 'SMSSV'"
      sSQL = sSQL & " AND ProcDefName <> 'SMRSV'"
      sSQL = sSQL & " AND ProcDefName <> 'SMSSV2'"
      sSQL = sSQL & " AND ProcDefName <> 'RSSSV'"
      sSQL = sSQL & " ORDER BY CSN"
      
      
      'Paste result to ws.Cells(10, LastCol)
            
           Next c 'End loop
           
    End If
Next

      Set moRSWips = New Recordset
      moRSWips.Open sSQL, moDBConn
      Set moRSWips.ActiveConnection = Nothing
      GetData = True
   Else
      MsgBox "No Start Date Entered", vbInformation, "GetData"
   End If
  
Exit_Function:
   Exit Function

ERROR_TRAP:
   Select Case Err.Number
   Case 0
   Case Else
      DisplayError msModName & "GetData", Err.Number, True, Err.Description
      Err.Clear
      Resume Exit_Function
   End Select
   
End Function

[MikeWaller]

I am going to mark this as solved since you gave me all you could with the info I provided, but I created another thread at http://www.excelforum.com/excel-prog...html?p=3094704 with more details. Thanks for helping as much as you have!