PDA

View Full Version : Long Code Help



inked
07-06-2006, 11:28 AM
I have the following code attached to a button. When the button is pressed, the code takes the values from the Input worksheet and populates the Data worksheet in the appropriate cells. The code, thanks to firefytr, is working flawlessley.



Sub Button1_Click()

Dim wsInput As Worksheet, wsData As Worksheet
Dim rngDate As Range, rngShift As Range
Dim rngLookConc As Range, rngLookDate As Range
Dim rngFind As Range, rngLoop As Range, c As Range, rngCol As Range
Dim strSearch As String, LastRow As Long
Dim i As Long, Cnt As Long, blnHide As Boolean, blnReplace As Boolean
Dim Msg As Long
Set wsInput = ThisWorkbook.Sheets("Input")
Set wsData = ThisWorkbook.Sheets("Data")
Set rngLookDate = wsData.Range("3:3")
Set rngLookConc = wsData.Range("E:E")
Set rngLookNum = wsData.Range("C:C")
Set rngDate = wsInput.Range("G8")
Set rngShift = wsInput.Range("H8")

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set rngCol = rngLookDate.Find(rngDate.Value, LookIn:=xlValues, lookat:=xlWhole)
If rngCol Is Nothing Then
MsgBox "That date is not found on the Data sheet!", vbExclamation, "ERROR!"
GoTo EndHere
End If
LastRow = wsInput.Range("G:H").Find("*", After:=wsInput.Range("G1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If LastRow < 21 Then
MsgBox "You have not entered any data in the Drop/Win table!", vbExclamation, "ERROR!"
GoTo EndHere
End If
Set rngLoop = wsInput.Range("F21", wsInput.Cells(wsInput.Rows.Count, 6).End(xlUp))
Cnt = 0
blnHide = rngLookConc.EntireColumn.Hidden
rngLookConc.EntireColumn.Hidden = False
For Each c In rngLoop
strSearch = c.Value & rngShift.Value
Set rngFind = rngLookConc.Find(strSearch, MatchCase:=True)
If Not rngFind Is Nothing Then
If Len(c.Offset(0, 1).Value) = 0 Or Len(c.Offset(0, 2).Value) = 0 Then GoTo SkipCode
If Len(c.Offset(0, 1).Value) <> 0 Or Len(c.Offset(0, 2).Value) <> 0 Then
If Len(wsData.Cells(rngFind.Row, rngCol.Column).Value) <> 0 And _
Len(wsData.Cells(rngFind.Row, rngCol.Column + 1).Value) <> 0 Then
Msg = MsgBox(c.Value & " already has data." & DNL & "Replace?", vbQuestion + vbYesNo)
blnReplace = True
End If
If Msg <> vbYes And blnReplace = True Then GoTo SkipRng
End If
wsData.Cells(rngFind.Row, rngCol.Column).Value = c.Offset(0, 1).Value
wsData.Cells(rngFind.Row, rngCol.Column + 1).Value = c.Offset(0, 2).Value
wsData.Cells(rngFind.Row, rngCol.Column + 2).FormulaR1C1 = "=RC[-2]-RC[-1]"
Cnt = Cnt + 1
blnReplace = False
SkipRng:
Set rngFind = Nothing
End If
SkipCode:
Next c
If blnHide Then rngLookConc.EntireColumn.Hidden = True

If Cnt <> 0 Then
MsgBox "A total of " & Cnt & " record(s) have been updated!", vbInformation, "Complete!"
Else
MsgBox "No values were updated!", vbInformation, "Complete!"
End If

EndHere:

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Set rngDate = Nothing
Set rngShift = Nothing
Set rngLookConc = Nothing
Set rngLookDate = Nothing
Set rngFind = Nothing
Set c = Nothing
Set rngCol = Nothing
Set wsData = Nothing
Set wsInput = Nothing

End Sub

What I'd like to do is add another row in the data worksheet, and only on this row, have the 1st and 3rd column populated instead of the first and second. The data worksheet is set up properly and the data is populating properly based on the input range G8 and H8; however it is populating in the same way that the other cells are. I think it is in the following lines, but I'm unsure how to tell it to only populate this one particular row according to the above desired result.


wsData.Cells(rngFind.Row, rngCol.Column).Value = c.Offset(0, 1).Value
wsData.Cells(rngFind.Row, rngCol.Column + 1).Value = c.Offset(0, 2).Value
wsData.Cells(rngFind.Row, rngCol.Column + 2).FormulaR1C1 = "=RC[-2]-RC[-1]"
Cnt = Cnt + 1


To give you an idea, the range in H8 is a dropdown menu containing "Day", "Swing,"Grave" and "Actuals" Only when "Actuals" is selected should the values be entered differently. I've attached the workbook if anyone would like to view. The cells that need to populate as I have described above would be for example: F9 and H9 on the Data worksheet.

Hope I haven't confused everyone.

Edward