PDA

View Full Version : Adjust code for one more criteria



inked
11-03-2006, 03:40 PM
I have the following bit of code that functions correctly given the value in H8, either "Day", "Grave", or "Swing" I want to add one more value to H8 ("Actuals").



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]"


I'm trying to make the following adjustment, but I'm not getting the correct result.

I want to say:

If Sheets("Input").Range("H8").Value = "Actuals"

Then the last line of the code above should be changed to:

wsData.Cells(rngFind.Row, rngCol.Column + 2).Value = c.Offset(0,2).Value

The problem seems to be in the IF statement. If I add the IF statement before the original code, the code overwrites the instruction given by the IF statement. If I place it after, it's seems to ignore the original code even when "Actuals" is not the value in H8.

Any ideas?

mdmackillop
11-03-2006, 04:06 PM
Try using Select
eg

Sub DoSelect()
Select Case Range("H8")
Case "Day"
Macro1
Case "Grave"
Macro2
Case "Swing"
Macro3
Case "Actuals"
Macro4
Case Else
Macro5
End Select
End Sub

inked
11-03-2006, 06:28 PM
Excuse me for the long code, but I am unsure how to implement the solution into the code I have.



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


Thanks again.