Copying or deleting row based on value found in other ws

A

aintlifegrand79

I have a userform that uses a button (cbChangeButton) to look up an existing
values (textbox: tbExistingProjectNumber)in multiple (9)worksheets and then
changes it to a new value (textbox: tbChangeProjectNumberTo) on those
worksheets. My problem is that if the tbEXistingProjectNumber begins with a
"P" and tbChangeProjectNumberTo begins with an "E" I need to have certain
information from worksheet 7 copied to the next empty row of worksheet 8. I
also need to make it so that if tbExistingProjectNumber begins with "B" and
tbChangeProjectNumberTo begins with "P" to delete the entire row in which
that Project number is found on worksheet 9. I have included all of my code
for this button but the parts I need help on are near the bottom (I think I
have the right idea but just might not have it in the right order or I am
missing a piece). Thank you in advance for any help you can provide.


Private Sub cbChangeButton_Click()
' Project Number not entered yet, brings up ErrorHandler
If Sheet1.Columns(1).Find(tbExistingProjectNumber.Value) Is Nothing Then
ufErrorHandler.Show
If Not Sheet1.Columns(1).Find(tbExistingProjectNumber.Value) Is Nothing
Then
Sheet1.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet1.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet1.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
Sheet2.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet2.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet2.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
Sheet3.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet3.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet3.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
Sheet4.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet4.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet4.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
Sheet5.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet5.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet5.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
Sheet6.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet6.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet6.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
Sheet7.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet7.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet7.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
If CStr(Left(tbExistingProjectNumber.Value, 1) = "P") And
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "E") Then
' Activate Sheet8
Sheet8.Activate
' Determine the next empty row
NextRow = _
Application.WorksheetFunction.CountA(Range("A:A")) + 1
' Transfer to Sheet8(Experience List)
Cells(NextRow, 1) = tbChangeProjectNumberTo.Value
Cells(NextRow, 2) =
Sheet7.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 3).Value
Cells(NextRow, 3) =
Sheet7.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 8).Value
End If
If CStr(Left(tbExistingProjectNumber.Value, 1) = "B") And
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "P") Then
Sheet9.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0, 0).Value
= Replace(Sheet9.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, Sheet9.Columns(1).Find(tbExistingProjectNumber.Value).Offset(0,
0).Value, tbChangeProjectNumberTo.Value)
End If
End If
End Sub
 
J

Joel

See if this code helps you find your problems. I dont know if you have
sheet1 - sheet7 defined. they should be
sheets("Sheet1")
to
sheets("Sheet7")

Private Sub cbChangeButton_Click()
' Project Number not entered yet, brings up ErrorHandler
Set c = Sheet1.Columns(1).Find(tbExistingProjectNumber.Value)
If c Is Nothing Then
ufErrorHandler.Show
Else
For i = 1 To 7
Sheets("sheet" & i).Columns(1). _
c.Value = tbChangeProjectNumberTo.Value
Next i

If CStr(Left(c.Value, 1) = "P") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "E") Then

' Activate Sheet8
With Sheets("Sheet8")
' Determine the next empty row
NextRow = .Range("A1").End(xlDown).Row + 1
' Transfer to Sheet8(Experience List)
.Cells(NextRow, 1) = tbChangeProjectNumberTo.Value
Set c1 = Sheets("Sheet7").Columns(1). _
Find(tbExistingProjectNumber.Value)
.Cells(NextRow, 2) = c1.Offset(0, 3).Value
.Cells(NextRow, 3) = c1.Offset(0, 8).Value
End With
End If

If CStr(Left(c.Value, 1) = "B") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "P") Then

Set c2 = Sheets("Sheet9").Columns(1). _
Find(tbExistingProjectNumber.Value).Value
c2.Value = tbChangeProjectNumberTo.Value

End If
End If
End Sub
 
J

Joel

I found a couple of more errors. Try this code instead

Private Sub cbChangeButton_Click()
' Project Number not entered yet, brings up ErrorHandler

For i = 1 To 7
Set c = Sheets("Sheet1").Columns(1).Find(tbExistingProjectNumber.Value)
If c Is Nothing Then
ufErrorHandler.Show
Else

Sheets("sheet" & i).Columns(1). _
c.Value = tbChangeProjectNumberTo.Value

If CStr(Left(c.Value, 1) = "P") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "E") Then

' Activate Sheet8
With Sheets("Sheet8")
' Determine the next empty row
NextRow = .Range("A1").End(xlDown).Row + 1
' Transfer to Sheet8(Experience List)
.Cells(NextRow, 1) = tbChangeProjectNumberTo.Value
Set c1 = Sheets("Sheet7").Columns(1). _
Find(tbExistingProjectNumber.Value)
.Cells(NextRow, 2) = c1.Offset(0, 3).Value
.Cells(NextRow, 3) = c1.Offset(0, 8).Value
End With
End If

If CStr(Left(c.Value, 1) = "B") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "P") Then

Set c2 = Sheets("Sheet9").Columns(1). _
Find(tbExistingProjectNumber.Value).Value
c2.Value = tbChangeProjectNumberTo.Value
End If
End If
Next i
End Sub
 
J

Joel

I think in you find stgatements you need xlpart (NOT XLWHOLE). I made the
modifications below.


Private Sub cbChangeButton_Click()
' Project Number not entered yet, brings up ErrorHandler

For i = 1 To 7
Set c =
Sheets("Sheet1").Columns(1).Find(tbExistingProjectNumber.Value, _
LookIn:=xlvlaues, lookat:=xlPart)
If c Is Nothing Then
ufErrorHandler.Show
Else

Sheets("sheet" & i).Columns(1). _
c.Value = tbChangeProjectNumberTo.Value

If CStr(Left(c.Value, 1) = "P") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "E") Then

' Activate Sheet8
With Sheets("Sheet8")
' Determine the next empty row
NextRow = .Range("A1").End(xlDown).Row + 1
' Transfer to Sheet8(Experience List)
.Cells(NextRow, 1) = tbChangeProjectNumberTo.Value
Set c1 = Sheets("Sheet7").Columns(1). _
Find(tbExistingProjectNumber.Value, _
LookIn:=xlvlaues, lookat:=xlPart)
.Cells(NextRow, 2) = c1.Offset(0, 3).Value
.Cells(NextRow, 3) = c1.Offset(0, 8).Value
End With
End If

If CStr(Left(c.Value, 1) = "B") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "P") Then

Set c2 = Sheets("Sheet9").Columns(1). _
Find(tbExistingProjectNumber.Value, _
LookIn:=xlvlaues, lookat:=xlPart)
c2.Value = tbChangeProjectNumberTo.Value
End If
End If
Next i
End Sub
 
J

Joel

Sorry! I made a couple of typos. this should be my final change. Again
sorry! this code is very hard to follow.


Private Sub cbChangeButton_Click()
' Project Number not entered yet, brings up ErrorHandler

For i = 1 To 7
Set c = Sheets("Sheet" &
i).Columns(1).Find(tbExistingProjectNumber.Value, _
LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
ufErrorHandler.Show
Else
c.Value = tbChangeProjectNumberTo.Value

If CStr(Left(c.Value, 1) = "P") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "E") Then

' Activate Sheet8
With Sheets("Sheet8")
' Determine the next empty row
NextRow = .Range("A1").End(xlDown).Row + 1
' Transfer to Sheet8(Experience List)
.Cells(NextRow, 1) = tbChangeProjectNumberTo.Value
Set c1 = Sheets("Sheet7").Columns(1). _
Find(tbExistingProjectNumber.Value, _
LookIn:=xlValues, lookat:=xlPart)
.Cells(NextRow, 2) = c1.Offset(0, 3).Value
.Cells(NextRow, 3) = c1.Offset(0, 8).Value
End With
End If

If CStr(Left(c.Value, 1) = "B") And _
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "P") Then

Set c2 = Sheets("Sheet9").Columns(1). _
Find(tbExistingProjectNumber.Value, _
LookIn:=xlValues, lookat:=xlPart)
c2.Value = tbChangeProjectNumberTo.Value
End If
End If
Next i
End Sub
 
A

aintlifegrand79

Joel thanks for your help but when I tried the code it didn't work and I
messed with it for a while and still couldn't get it to work. I know my code
is a bit hard to follow and for that i am sorry but I really appreciate your
help.
 
A

aintlifegrand79

The debugger always highlights this portion of the code:
If CStr(Left(tbExistingProjectNumber.Value, 1) = "P") And
CStr(Left(tbChangeProjectNumberTo.Value, 1) = "E") Then

I don't know if that will help at all but it seems to be where my code is
some how tripping up.
 
J

Joel

I copied your original code which had the CSTR() function. this is not
needed in the code. The problem is CSTR want to see a number. If you have a
P or E in front of the number CSTR will err.

Private Sub cbChangeButton_Click()
' Project Number not entered yet, brings up ErrorHandler
Set tbExistingProjectNumber = Range("A1")
Set tbChangeProjectNumberTo = Range("A1")
For i = 1 To 7
Set c = Sheets("Sheet" & _
i).Columns(1).Find(tbExistingProjectNumber.Value, _
LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
ufErrorHandler.Show
Else
c.Value = tbChangeProjectNumberTo.Value

If Left(c.Value, 1) = "P" And _
Left(tbChangeProjectNumberTo.Value, 1) = "E" Then

' Activate Sheet8
With Sheets("Sheet8")
' Determine the next empty row
NextRow = .Range("A1").End(xlDown).Row + 1
' Transfer to Sheet8(Experience List)
.Cells(NextRow, 1) = tbChangeProjectNumberTo.Value
Set c1 = Sheets("Sheet7").Columns(1). _
Find(tbExistingProjectNumber.Value, _
LookIn:=xlValues, lookat:=xlPart)
.Cells(NextRow, 2) = c1.Offset(0, 3).Value
.Cells(NextRow, 3) = c1.Offset(0, 8).Value
End With
End If

If Left(c.Value, 1) = "B" And _
Left(tbChangeProjectNumberTo.Value, 1) = "P" Then

Set c2 = Sheets("Sheet9").Columns(1). _
Find(tbExistingProjectNumber.Value, _
LookIn:=xlValues, lookat:=xlPart)
c2.Value = tbChangeProjectNumberTo.Value
End If
End If
Next i
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Finding a cell value and deleting the row with that value in it 4
Transfer array element offset value to a matched value 3
Check column for a value and if not there execute series of functi 4
Reference Value not Formula in cell via VBA - Err91 prt3 2
If texbox value begins with "E" then send to another sheet. 1
if value begins with "" then 10
Update worksheets 1
When found add it to the last and display total in Msgbox 23

Top