ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   HELP WITH MY MACRO (https://www.excelbanter.com/excel-discussion-misc-queries/166355-help-my-macro.html)

jcontrer
HELP WITH MY MACRO
 
I have this macro:
Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"

SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
End With

End Sub

Instead of just copying the row from the bilingual sheet and pasting them on
the sumsheet, i want the macro to CUT the row and paste it in the sumsheet.
so it is no longer in the bilingual sheet.
--
I appreciate the help; thanks in advance

Jim Thomlinson
HELP WITH MY MACRO
 
In the grander scheme of things cut is just a copy followed by a delete (that
is what the computer is actually doing). Your issue is that if you delete
while moving down the sheet it will mess up your movement. There are two ways
around that. One is to travel bottom to top and the other is to create a
single big range to be deleted at the end once you have gone through the
entire sheet. Here is how you would do the second option

Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"
dim rngToDelete as range
SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
if rngtodelete is nothing then
set rngtodelete =
Sheets(BilingualSheet).Rows(BiRowCount)
else
set rngtodelete = union(rngtodelete, _
Sheets(BilingualSheet).Rows(BiRowCount))
end if
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
if not rngtodelete is nothing then rngtodelete.delete
End With

--
HTH...

Jim Thomlinson


"jcontrer" wrote:

I have this macro:
Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"

SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
End With

End Sub

Instead of just copying the row from the bilingual sheet and pasting them on
the sumsheet, i want the macro to CUT the row and paste it in the sumsheet.
so it is no longer in the bilingual sheet.
--
I appreciate the help; thanks in advance

jcontrer
HELP WITH MY MACRO
 
Jim,
I tried to un the macro, yet it had a compile error: syntax error message
prompt. and the line;
set rngtodelete =
was highlited.


--
thanks in advance


"Jim Thomlinson" wrote:

In the grander scheme of things cut is just a copy followed by a delete (that
is what the computer is actually doing). Your issue is that if you delete
while moving down the sheet it will mess up your movement. There are two ways
around that. One is to travel bottom to top and the other is to create a
single big range to be deleted at the end once you have gone through the
entire sheet. Here is how you would do the second option

Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"
dim rngToDelete as range
SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
if rngtodelete is nothing then
set rngtodelete =
Sheets(BilingualSheet).Rows(BiRowCount)
else
set rngtodelete = union(rngtodelete, _
Sheets(BilingualSheet).Rows(BiRowCount))
end if
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
if not rngtodelete is nothing then rngtodelete.delete
End With

--
HTH...

Jim Thomlinson


"jcontrer" wrote:

I have this macro:
Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"

SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
End With

End Sub

Instead of just copying the row from the bilingual sheet and pasting them on
the sumsheet, i want the macro to CUT the row and paste it in the sumsheet.
so it is no longer in the bilingual sheet.
--
I appreciate the help; thanks in advance

Jim Thomlinson
HELP WITH MY MACRO
 
Did it wrap the text on you. (Note that I declared all of your variables for
you which is always s good idea). Give this a try...

Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"
Dim rngToDelete As Range
Dim SumRowCount As Long
Dim TermRowCount As Long
Dim BiRowCount As Long
Dim FirstName As String
Dim LastName As String

SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
If rngToDelete Is Nothing Then
Set rngToDelete = _
Sheets(BilingualSheet).Rows(BiRowCount)
Else
Set rngToDelete = Union(rngToDelete, _
Sheets(BilingualSheet).Rows(BiRowCount))
End If
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
If Not rngToDelete Is Nothing Then rngToDelete.Delete
End With
End Sub
--
HTH...

Jim Thomlinson


"jcontrer" wrote:

Jim,
I tried to un the macro, yet it had a compile error: syntax error message
prompt. and the line;
set rngtodelete =
was highlited.


--
thanks in advance


"Jim Thomlinson" wrote:

In the grander scheme of things cut is just a copy followed by a delete (that
is what the computer is actually doing). Your issue is that if you delete
while moving down the sheet it will mess up your movement. There are two ways
around that. One is to travel bottom to top and the other is to create a
single big range to be deleted at the end once you have gone through the
entire sheet. Here is how you would do the second option

Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"
dim rngToDelete as range
SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
if rngtodelete is nothing then
set rngtodelete =
Sheets(BilingualSheet).Rows(BiRowCount)
else
set rngtodelete = union(rngtodelete, _
Sheets(BilingualSheet).Rows(BiRowCount))
end if
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
if not rngtodelete is nothing then rngtodelete.delete
End With

--
HTH...

Jim Thomlinson


"jcontrer" wrote:

I have this macro:
Sub GetTerminations()
Const SumSheet = "TERMINATED EMPLOYEES"
Const BilingualSheet = "Employee Bi-Lingual Skills"
Const TermSheet = "New Terminations"
Const TermLastName = "A"
Const TermFirstName = "B"
Const BiLastName = "A"
Const BiFirstName = "B"
Const SumLastName = "A"
Const SumFirstName = "B"

SumRowCount = 1
TermRowCount = 1

With Sheets(TermSheet)
Do While .Range(TermLastName & TermRowCount) < ""
LastName = .Range(TermLastName & TermRowCount)
FirstName = .Range(TermFirstName & TermRowCount)
With Sheets(BilingualSheet)
BiRowCount = 1
Do While .Range(BiLastName & BiRowCount) < ""
If (.Range(BiLastName & BiRowCount) = LastName) And _
(.Range(BiFirstName & BiRowCount) = FirstName) Then

With Sheets(SumSheet)
Sheets(BilingualSheet).Rows(BiRowCount).Copy _
Destination:=.Rows(SumRowCount)
SumRowCount = SumRowCount + 1
End With
Exit Do
End If
BiRowCount = BiRowCount + 1
Loop
End With
TermRowCount = TermRowCount + 1
Loop
End With

End Sub

Instead of just copying the row from the bilingual sheet and pasting them on
the sumsheet, i want the macro to CUT the row and paste it in the sumsheet.
so it is no longer in the bilingual sheet.
--
I appreciate the help; thanks in advance


All times are GMT +1. The time now is 12:33 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com