dyhoerium
09-18-2009, 03:01 PM
Hi, I'm working on this and have already gotten help from the community for one part of it, but I've hit another brick wall! I have an if/then function and I want it to look for two things. I can get it to work for 1, but not two. I've provided more information in the code. Thanks for any help available!
Option Compare Text
Sub CarlKramer()
Dim LSearchRow As Integer
On Error GoTo Err_Execute
LSearchRow = 3
Workbooks.Open Filename:="P:\Worklist Tracking\Carl.xlsx"
Windows("Worklist Tracking 7th Generation.xlsm").Activate
Sheets("Raw Data").Select
While Len(Range("F" & CStr(LSearchRow)).Value) > 0
' The following line is my problem. I need this to check "D" and "E" for "Carl"
' and copy that row if either of them are true. Sometimes they
' will both be true and other times only one or the other will be
' true. I need the row copied exactly one time for either scenario.
If Range("D" & CStr(LSearchRow)).Value = "Carl" Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Windows("Carl.xlsx").Activate
Sheets("Raw Data").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Windows("Worklist Tracking 7th Generation.xlsm").Activate
Sheets("Raw Data").Select
End If
LSearchRow = LSearchRow + 1
Wend
Windows("Carl.xlsx").Activate
Range("A1").End(xlDown).Offset(0, 0).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Windows("Carl.xlsx").Close
Application.CutCopyMode = False
Windows("Worklist Tracking 7th Generation.xlsm").Activate
Sheets("Macros").Select
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Option Compare Text
Sub CarlKramer()
Dim LSearchRow As Integer
On Error GoTo Err_Execute
LSearchRow = 3
Workbooks.Open Filename:="P:\Worklist Tracking\Carl.xlsx"
Windows("Worklist Tracking 7th Generation.xlsm").Activate
Sheets("Raw Data").Select
While Len(Range("F" & CStr(LSearchRow)).Value) > 0
' The following line is my problem. I need this to check "D" and "E" for "Carl"
' and copy that row if either of them are true. Sometimes they
' will both be true and other times only one or the other will be
' true. I need the row copied exactly one time for either scenario.
If Range("D" & CStr(LSearchRow)).Value = "Carl" Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Windows("Carl.xlsx").Activate
Sheets("Raw Data").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Windows("Worklist Tracking 7th Generation.xlsm").Activate
Sheets("Raw Data").Select
End If
LSearchRow = LSearchRow + 1
Wend
Windows("Carl.xlsx").Activate
Range("A1").End(xlDown).Offset(0, 0).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Windows("Carl.xlsx").Close
Application.CutCopyMode = False
Windows("Worklist Tracking 7th Generation.xlsm").Activate
Sheets("Macros").Select
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub