CompareValues

I am looking for VB script to accomplish the requests below.

A. I need to be able to compare the numbers with the one above it, and
insert a row if the numbers are not the same..
BEFORE
01 01
01 01
01 01
02
02 02
02

B. If I have a column of numbers 12345, 11000, 11045, and so forth, I
want to be able to search the sheet for the items in this column and
remove the row of data if it ends in "5"
ie. ****5

C. I also want to do a search for the name column, return all values
where this is true, then cut the rows/columns where this is true into a
new sheet/or .xls file
ie.
wyoming 01 free blue
wyoming 02 free red
kansas 01
....this function would cut/paste the four columns and two or more rows
where I search for the word "wyoming"

D. I want to calculate a sum until it meets a row with a space,
calcthesum, the move down, calc next sum, etc..

E. I have a couple tables in Access, and want to replace values in
excel with corresponding values in Access.
ie. ID 16455 in excel
ID 16455, desc blahblah in Access
ID blahblah in excel after replace..

Thanks for helping me by addressing any of these issues, figured it
would be faster to go this route as I could be looking in the help's
for hours.
~schaapiee

Here is macro coding for the 1st 4 requests, all assume that the data of
interest is in column A - declared by constant SearchColumn in each routine:

A - Split at numeric changes
Sub SplitAtNewNumber()
Const SearchColumn = "A" ' change as needed
Dim LastNum As Long ' change type if needed
Dim CurrentNum As Long ' change type if needed

'go to first cell with number in it
Range(SearchColumn & "1").Select
'initialize values
LastNum = ActiveCell.Value
Application.ScreenUpdating = False
Do Until IsEmpty(ActiveCell)
CurrentNum = ActiveCell.Value
If LastNum CurrentNum Then
'insert column
Selection.EntireRow.Insert
LastNum = CurrentNum
End If
'move down 1 row
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True

End Sub

B - Removing rows with numbers that end with a 5

Sub TestRemoveByDiv5()
Const SearchColumn = "A" ' change as required

'find last row with entry in the column
Range(SearchColumn & "65536").End(xlUp).Select
Application.ScreenUpdating = False ' speeds things up
Do While ActiveCell.Row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
'move up 1 row
ActiveCell.Offset(-1, 0).Activate
Loop
'one last test for row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
Application.ScreenUpdating = True
Range("A1").Select

End Sub

C - the cut'n'paste stuff, or Match and Move
Sub MatchAndMoveIt()
Const SearchColumn = "A"
Dim FindResult As Range
Dim SearchFor As String

SearchFor = InputBox("Enter Search Phrase", "Begin Move", "nothing")
If SearchFor = "nothing" Then
Exit Sub
End If
Application.ScreenUpdating = False
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)

Do Until FindResult Is Nothing
Range(FindResult.Address & ":" &
Range(FindResult.Address).End(xlToRight).Address). Select
Selection.Cut
Worksheets("MatchAndMove2").Select
Range("A65536").End(xlUp).Select
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(1, 0).Activate
End If
ActiveSheet.Paste
Worksheets("MatchAndMove1").Select
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)
Loop
Range(SearchColumn & "1").Select
Application.ScreenUpdating = True

End Sub

D - the sum numbers to blank cell part:
Sub CalcGroupsToEmpties()
Const SearchColumn = "A"
Dim GroupTotal As Single ' floating point
Dim LastRowToSearch As Long

LastRowToSearch = Range(SearchColumn & "65536").End(xlUp).Row + 1
Range(SearchColumn & "1").Select ' 1st row with value in it

Do Until ActiveCell.Row LastRowToSearch
GroupTotal = 0
Do Until IsEmpty(ActiveCell)
GroupTotal = GroupTotal + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell = GroupTotal
ActiveCell.Offset(1, 0).Activate
Loop

End Sub

I've not provided E - little complex here, don't know whether you'd prefer
to use DAO or ADO or what to control Access.
If it were me I'd open up an instance of Access and open the MDB and use the
DLOOKUP() functin inside of access to return your description and replace the
search parameter with the returned value.

Hopefully the hours saved with 4 solutions will give you the time needed to
do the Access interface portion. You could even consider exporting the
appropriate table or query result to an Excel worksheet and put that into
your Excel workbook and use VLOOKUP() or similar function to get the data you
need.

"schaapiee" wrote:

I am looking for VB script to accomplish the requests below.

A. I need to be able to compare the numbers with the one above it, and
insert a row if the numbers are not the same..
BEFORE
01 01
01 01
01 01
02
02 02
02

B. If I have a column of numbers 12345, 11000, 11045, and so forth, I
want to be able to search the sheet for the items in this column and
remove the row of data if it ends in "5"
ie. ****5

C. I also want to do a search for the name column, return all values
where this is true, then cut the rows/columns where this is true into a
new sheet/or .xls file
ie.
wyoming 01 free blue
wyoming 02 free red
kansas 01
....this function would cut/paste the four columns and two or more rows
where I search for the word "wyoming"

D. I want to calculate a sum until it meets a row with a space,
calcthesum, the move down, calc next sum, etc..

E. I have a couple tables in Access, and want to replace values in
excel with corresponding values in Access.
ie. ID 16455 in excel
ID 16455, desc blahblah in Access
ID blahblah in excel after replace..

Thanks for helping me by addressing any of these issues, figured it
would be faster to go this route as I could be looking in the help's
for hours.
~schaapiee

Thanks that code is great, just what I was looking for..
I have come across a couple more issues if anyone can help with these:

1. I want to add the current date in the format of 01/01/2007 into the
filename when I save my files which are being created on a macro. I am
not able to see a way to do this in excel, as it takes everything as a
string literal, and therefore I cannot substitute Date(), or Now()
etc.. at the end of the string..so example being
Blah_Report_01012006.xls, and the date changes each time it is ran.

2. I have a default sheet being created/formatted through a macro and
then select values being cut.pasted over from another sheet, I have to
do this b/c the cells being copied are the SUMs from question D in the
previous. My problem is that everytime this report is ran, the cells
where the subtotal values are, will be changing, so I need code where
it recognizes the value as a subtotal and not just a number, then copy
that into the default sheet into the cells I have already designated.
Because there are going to be mutliple instances of sums, I am having a
hard time figuring out how to make sure excel keeps it all straight.

let me know if you have further questions, and thanks again for any
help.

JLatham wrote:
Here is macro coding for the 1st 4 requests, all assume that the data of
interest is in column A - declared by constant SearchColumn in each routine:

A - Split at numeric changes
Sub SplitAtNewNumber()
Const SearchColumn = "A" ' change as needed
Dim LastNum As Long ' change type if needed
Dim CurrentNum As Long ' change type if needed

'go to first cell with number in it
Range(SearchColumn & "1").Select
'initialize values
LastNum = ActiveCell.Value
Application.ScreenUpdating = False
Do Until IsEmpty(ActiveCell)
CurrentNum = ActiveCell.Value
If LastNum CurrentNum Then
'insert column
Selection.EntireRow.Insert
LastNum = CurrentNum
End If
'move down 1 row
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True

End Sub

B - Removing rows with numbers that end with a 5

Sub TestRemoveByDiv5()
Const SearchColumn = "A" ' change as required

'find last row with entry in the column
Range(SearchColumn & "65536").End(xlUp).Select
Application.ScreenUpdating = False ' speeds things up
Do While ActiveCell.Row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
'move up 1 row
ActiveCell.Offset(-1, 0).Activate
Loop
'one last test for row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
Application.ScreenUpdating = True
Range("A1").Select

End Sub

C - the cut'n'paste stuff, or Match and Move
Sub MatchAndMoveIt()
Const SearchColumn = "A"
Dim FindResult As Range
Dim SearchFor As String

SearchFor = InputBox("Enter Search Phrase", "Begin Move", "nothing")
If SearchFor = "nothing" Then
Exit Sub
End If
Application.ScreenUpdating = False
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)

Do Until FindResult Is Nothing
Range(FindResult.Address & ":" &
Range(FindResult.Address).End(xlToRight).Address). Select
Selection.Cut
Worksheets("MatchAndMove2").Select
Range("A65536").End(xlUp).Select
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(1, 0).Activate
End If
ActiveSheet.Paste
Worksheets("MatchAndMove1").Select
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)
Loop
Range(SearchColumn & "1").Select
Application.ScreenUpdating = True

End Sub

D - the sum numbers to blank cell part:
Sub CalcGroupsToEmpties()
Const SearchColumn = "A"
Dim GroupTotal As Single ' floating point
Dim LastRowToSearch As Long

LastRowToSearch = Range(SearchColumn & "65536").End(xlUp).Row + 1
Range(SearchColumn & "1").Select ' 1st row with value in it

Do Until ActiveCell.Row LastRowToSearch
GroupTotal = 0
Do Until IsEmpty(ActiveCell)
GroupTotal = GroupTotal + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell = GroupTotal
ActiveCell.Offset(1, 0).Activate
Loop

End Sub

I've not provided E - little complex here, don't know whether you'd prefer
to use DAO or ADO or what to control Access.
If it were me I'd open up an instance of Access and open the MDB and use the
DLOOKUP() functin inside of access to return your description and replace the
search parameter with the returned value.

Hopefully the hours saved with 4 solutions will give you the time needed to
do the Access interface portion. You could even consider exporting the
appropriate table or query result to an Excel worksheet and put that into
your Excel workbook and use VLOOKUP() or similar function to get the data you
need.

"schaapiee" wrote:

I am looking for VB script to accomplish the requests below.

A. I need to be able to compare the numbers with the one above it, and
insert a row if the numbers are not the same..
BEFORE
01 01
01 01
01 01
02
02 02
02

B. If I have a column of numbers 12345, 11000, 11045, and so forth, I
want to be able to search the sheet for the items in this column and
remove the row of data if it ends in "5"
ie. ****5

C. I also want to do a search for the name column, return all values
where this is true, then cut the rows/columns where this is true into a
new sheet/or .xls file
ie.
wyoming 01 free blue
wyoming 02 free red
kansas 01
....this function would cut/paste the four columns and two or more rows
where I search for the word "wyoming"

D. I want to calculate a sum until it meets a row with a space,
calcthesum, the move down, calc next sum, etc..

E. I have a couple tables in Access, and want to replace values in
excel with corresponding values in Access.
ie. ID 16455 in excel
ID 16455, desc blahblah in Access
ID blahblah in excel after replace..

Thanks for helping me by addressing any of these issues, figured it
would be faster to go this route as I could be looking in the help's
for hours.
~schaapiee

Addendum to above posting..I have another question to post )

3. Here is what I have
@@@1 ### ###
@@@1 ### ###
subtotal1
@@@2 ### ###
@@@2 ### ###
@@@2 ### ###
@@@2 ### ###
subtotal2

I am looking to copy the values in cells 1 and 2 down, and the delete
all instances of the ones above it, so whats left would be:
@@@1 ### subtotal1
@@@2 ### subtotal2
and so on.. I can do this manually, but looking for a macro to loop
through.
Thanks

schaapiee wrote:
Thanks that code is great, just what I was looking for..
I have come across a couple more issues if anyone can help with these:

1. I want to add the current date in the format of 01/01/2007 into the
filename when I save my files which are being created on a macro. I am
not able to see a way to do this in excel, as it takes everything as a
string literal, and therefore I cannot substitute Date(), or Now()
etc.. at the end of the string..so example being
Blah_Report_01012006.xls, and the date changes each time it is ran.

2. I have a default sheet being created/formatted through a macro and
then select values being cut.pasted over from another sheet, I have to
do this b/c the cells being copied are the SUMs from question D in the
previous. My problem is that everytime this report is ran, the cells
where the subtotal values are, will be changing, so I need code where
it recognizes the value as a subtotal and not just a number, then copy
that into the default sheet into the cells I have already designated.
Because there are going to be mutliple instances of sums, I am having a
hard time figuring out how to make sure excel keeps it all straight.

let me know if you have further questions, and thanks again for any
help.

JLatham wrote:
Here is macro coding for the 1st 4 requests, all assume that the data of
interest is in column A - declared by constant SearchColumn in each routine:

A - Split at numeric changes
Sub SplitAtNewNumber()
Const SearchColumn = "A" ' change as needed
Dim LastNum As Long ' change type if needed
Dim CurrentNum As Long ' change type if needed

'go to first cell with number in it
Range(SearchColumn & "1").Select
'initialize values
LastNum = ActiveCell.Value
Application.ScreenUpdating = False
Do Until IsEmpty(ActiveCell)
CurrentNum = ActiveCell.Value
If LastNum CurrentNum Then
'insert column
Selection.EntireRow.Insert
LastNum = CurrentNum
End If
'move down 1 row
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True

End Sub

B - Removing rows with numbers that end with a 5

Sub TestRemoveByDiv5()
Const SearchColumn = "A" ' change as required

'find last row with entry in the column
Range(SearchColumn & "65536").End(xlUp).Select
Application.ScreenUpdating = False ' speeds things up
Do While ActiveCell.Row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
'move up 1 row
ActiveCell.Offset(-1, 0).Activate
Loop
'one last test for row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
Application.ScreenUpdating = True
Range("A1").Select

End Sub

C - the cut'n'paste stuff, or Match and Move
Sub MatchAndMoveIt()
Const SearchColumn = "A"
Dim FindResult As Range
Dim SearchFor As String

SearchFor = InputBox("Enter Search Phrase", "Begin Move", "nothing")
If SearchFor = "nothing" Then
Exit Sub
End If
Application.ScreenUpdating = False
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)

Do Until FindResult Is Nothing
Range(FindResult.Address & ":" &
Range(FindResult.Address).End(xlToRight).Address). Select
Selection.Cut
Worksheets("MatchAndMove2").Select
Range("A65536").End(xlUp).Select
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(1, 0).Activate
End If
ActiveSheet.Paste
Worksheets("MatchAndMove1").Select
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)
Loop
Range(SearchColumn & "1").Select
Application.ScreenUpdating = True

End Sub

D - the sum numbers to blank cell part:
Sub CalcGroupsToEmpties()
Const SearchColumn = "A"
Dim GroupTotal As Single ' floating point
Dim LastRowToSearch As Long

LastRowToSearch = Range(SearchColumn & "65536").End(xlUp).Row + 1
Range(SearchColumn & "1").Select ' 1st row with value in it

Do Until ActiveCell.Row LastRowToSearch
GroupTotal = 0
Do Until IsEmpty(ActiveCell)
GroupTotal = GroupTotal + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell = GroupTotal
ActiveCell.Offset(1, 0).Activate
Loop

End Sub

I've not provided E - little complex here, don't know whether you'd prefer
to use DAO or ADO or what to control Access.
If it were me I'd open up an instance of Access and open the MDB and use the
DLOOKUP() functin inside of access to return your description and replace the
search parameter with the returned value.

Hopefully the hours saved with 4 solutions will give you the time needed to
do the Access interface portion. You could even consider exporting the
appropriate table or query result to an Excel worksheet and put that into
your Excel workbook and use VLOOKUP() or similar function to get the data you
need.

"schaapiee" wrote:

I am looking for VB script to accomplish the requests below.

A. I need to be able to compare the numbers with the one above it, and
insert a row if the numbers are not the same..
BEFORE
01 01
01 01
01 01
02
02 02
02

B. If I have a column of numbers 12345, 11000, 11045, and so forth, I
want to be able to search the sheet for the items in this column and
remove the row of data if it ends in "5"
ie. ****5

C. I also want to do a search for the name column, return all values
where this is true, then cut the rows/columns where this is true into a
new sheet/or .xls file
ie.
wyoming 01 free blue
wyoming 02 free red
kansas 01
....this function would cut/paste the four columns and two or more rows
where I search for the word "wyoming"

D. I want to calculate a sum until it meets a row with a space,
calcthesum, the move down, calc next sum, etc..

E. I have a couple tables in Access, and want to replace values in
excel with corresponding values in Access.
ie. ID 16455 in excel
ID 16455, desc blahblah in Access
ID blahblah in excel after replace..

Thanks for helping me by addressing any of these issues, figured it
would be faster to go this route as I could be looking in the help's
for hours.
~schaapiee

For #1:
Sub DateFileSave()
Dim yourFilename As String

'somehow you've gotten a basic filename into
'a string, which we are calling yourFilename here
'for explanation I'll say it looks like this
'at this point
yourFilename = "C:\My Documents\NewExcelFile"
'to add the current date to the filename in dd/mm/yyyy format use this
yourFilename = yourFilename & Format(Now(), "dd/mm/yyyy") & ".xls"
MsgBox "Filename now looks like: " & yourFilename
'personally I think you'd be better off using something like this:
yourFilename = "C:My Documents\NewExcelFile"
yourFilename = yourFilename & Format(Now(), "_dd_mm_yyyy") & ".xls"
MsgBox "Filename now looks like: " & yourFilename
'continue on to save the file

End Sub

#2 - well, I'm just seriously confused. I'm sure it can be done, I just
can't from the information provided. Need to look for differences in
location/layout or something of those subtotals to identify them. I'll look
around (or someone who knows already may answer sooner) to see if there's a
property to examine to see if it's a subtotal in VBA code. Not something I'm
familiar with.

For the addendum in your next post - figure out where 1st number to be
copied down is, perhaps by simple expedient of selecting that cell before
beginning the macro. Save the 2 values to be copied. Move down the sheet
until you find an empty cell in the @@@1 column and look over and see if
something is in the subtotal# column.
Save the subtotal# value and then stuff it back into that cell, paste the
@@@1 and ### values saved earlier there. Go back and delete the rows with
the unwanted data. Practice this a piece at a time until you know where you
are going to be left on the sheet after those deletes, then move down
appropriate # of rows to the next @@@- entry and repeat until you find a cell
with both the 1st column (where @@@2 is at) AND the column where you'd expect
a subtotaln to be in are empty, then I would presume that you're done.

Remember that you're going to have to save the subtotal# value before you
delete the rows above it or obviously it's going to disappear.



"schaapiee" wrote:

Thanks that code is great, just what I was looking for..
I have come across a couple more issues if anyone can help with these:

1. I want to add the current date in the format of 01/01/2007 into the
filename when I save my files which are being created on a macro. I am
not able to see a way to do this in excel, as it takes everything as a
string literal, and therefore I cannot substitute Date(), or Now()
etc.. at the end of the string..so example being
Blah_Report_01012006.xls, and the date changes each time it is ran.

2. I have a default sheet being created/formatted through a macro and
then select values being cut.pasted over from another sheet, I have to
do this b/c the cells being copied are the SUMs from question D in the
previous. My problem is that everytime this report is ran, the cells
where the subtotal values are, will be changing, so I need code where
it recognizes the value as a subtotal and not just a number, then copy
that into the default sheet into the cells I have already designated.
Because there are going to be mutliple instances of sums, I am having a
hard time figuring out how to make sure excel keeps it all straight.

let me know if you have further questions, and thanks again for any
help.

JLatham wrote:
Here is macro coding for the 1st 4 requests, all assume that the data of
interest is in column A - declared by constant SearchColumn in each routine:

A - Split at numeric changes
Sub SplitAtNewNumber()
Const SearchColumn = "A" ' change as needed
Dim LastNum As Long ' change type if needed
Dim CurrentNum As Long ' change type if needed

'go to first cell with number in it
Range(SearchColumn & "1").Select
'initialize values
LastNum = ActiveCell.Value
Application.ScreenUpdating = False
Do Until IsEmpty(ActiveCell)
CurrentNum = ActiveCell.Value
If LastNum CurrentNum Then
'insert column
Selection.EntireRow.Insert
LastNum = CurrentNum
End If
'move down 1 row
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True

End Sub

B - Removing rows with numbers that end with a 5

Sub TestRemoveByDiv5()
Const SearchColumn = "A" ' change as required

'find last row with entry in the column
Range(SearchColumn & "65536").End(xlUp).Select
Application.ScreenUpdating = False ' speeds things up
Do While ActiveCell.Row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
'move up 1 row
ActiveCell.Offset(-1, 0).Activate
Loop
'one last test for row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
Application.ScreenUpdating = True
Range("A1").Select

End Sub

C - the cut'n'paste stuff, or Match and Move
Sub MatchAndMoveIt()
Const SearchColumn = "A"
Dim FindResult As Range
Dim SearchFor As String

SearchFor = InputBox("Enter Search Phrase", "Begin Move", "nothing")
If SearchFor = "nothing" Then
Exit Sub
End If
Application.ScreenUpdating = False
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)

Do Until FindResult Is Nothing
Range(FindResult.Address & ":" &
Range(FindResult.Address).End(xlToRight).Address). Select
Selection.Cut
Worksheets("MatchAndMove2").Select
Range("A65536").End(xlUp).Select
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(1, 0).Activate
End If
ActiveSheet.Paste
Worksheets("MatchAndMove1").Select
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)
Loop
Range(SearchColumn & "1").Select
Application.ScreenUpdating = True

End Sub

D - the sum numbers to blank cell part:
Sub CalcGroupsToEmpties()
Const SearchColumn = "A"
Dim GroupTotal As Single ' floating point
Dim LastRowToSearch As Long

LastRowToSearch = Range(SearchColumn & "65536").End(xlUp).Row + 1
Range(SearchColumn & "1").Select ' 1st row with value in it

Do Until ActiveCell.Row LastRowToSearch
GroupTotal = 0
Do Until IsEmpty(ActiveCell)
GroupTotal = GroupTotal + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell = GroupTotal
ActiveCell.Offset(1, 0).Activate
Loop

End Sub

I've not provided E - little complex here, don't know whether you'd prefer
to use DAO or ADO or what to control Access.
If it were me I'd open up an instance of Access and open the MDB and use the
DLOOKUP() functin inside of access to return your description and replace the
search parameter with the returned value.

Hopefully the hours saved with 4 solutions will give you the time needed to
do the Access interface portion. You could even consider exporting the
appropriate table or query result to an Excel worksheet and put that into
your Excel workbook and use VLOOKUP() or similar function to get the data you
need.

"schaapiee" wrote:

I am looking for VB script to accomplish the requests below.

A. I need to be able to compare the numbers with the one above it, and
insert a row if the numbers are not the same..
BEFORE
01 01
01 01
01 01
02
02 02
02

B. If I have a column of numbers 12345, 11000, 11045, and so forth, I
want to be able to search the sheet for the items in this column and
remove the row of data if it ends in "5"
ie. ****5

C. I also want to do a search for the name column, return all values
where this is true, then cut the rows/columns where this is true into a
new sheet/or .xls file
ie.
wyoming 01 free blue
wyoming 02 free red
kansas 01
....this function would cut/paste the four columns and two or more rows
where I search for the word "wyoming"

D. I want to calculate a sum until it meets a row with a space,
calcthesum, the move down, calc next sum, etc..

E. I have a couple tables in Access, and want to replace values in
excel with corresponding values in Access.
ie. ID 16455 in excel
ID 16455, desc blahblah in Access
ID blahblah in excel after replace..

Thanks for helping me by addressing any of these issues, figured it
would be faster to go this route as I could be looking in the help's
for hours.
~schaapiee

I have been able to figure out all my issues, thanks for your help.

JLatham wrote:
For #1:
Sub DateFileSave()
Dim yourFilename As String

'somehow you've gotten a basic filename into
'a string, which we are calling yourFilename here
'for explanation I'll say it looks like this
'at this point
yourFilename = "C:\My Documents\NewExcelFile"
'to add the current date to the filename in dd/mm/yyyy format use this
yourFilename = yourFilename & Format(Now(), "dd/mm/yyyy") & ".xls"
MsgBox "Filename now looks like: " & yourFilename
'personally I think you'd be better off using something like this:
yourFilename = "C:My Documents\NewExcelFile"
yourFilename = yourFilename & Format(Now(), "_dd_mm_yyyy") & ".xls"
MsgBox "Filename now looks like: " & yourFilename
'continue on to save the file

End Sub

#2 - well, I'm just seriously confused. I'm sure it can be done, I just
can't from the information provided. Need to look for differences in
location/layout or something of those subtotals to identify them. I'll look
around (or someone who knows already may answer sooner) to see if there's a
property to examine to see if it's a subtotal in VBA code. Not something I'm
familiar with.

For the addendum in your next post - figure out where 1st number to be
copied down is, perhaps by simple expedient of selecting that cell before
beginning the macro. Save the 2 values to be copied. Move down the sheet
until you find an empty cell in the @@@1 column and look over and see if
something is in the subtotal# column.
Save the subtotal# value and then stuff it back into that cell, paste the
@@@1 and ### values saved earlier there. Go back and delete the rows with
the unwanted data. Practice this a piece at a time until you know where you
are going to be left on the sheet after those deletes, then move down
appropriate # of rows to the next @@@- entry and repeat until you find a cell
with both the 1st column (where @@@2 is at) AND the column where you'd expect
a subtotaln to be in are empty, then I would presume that you're done.

Remember that you're going to have to save the subtotal# value before you
delete the rows above it or obviously it's going to disappear.



"schaapiee" wrote:

Thanks that code is great, just what I was looking for..
I have come across a couple more issues if anyone can help with these:

1. I want to add the current date in the format of 01/01/2007 into the
filename when I save my files which are being created on a macro. I am
not able to see a way to do this in excel, as it takes everything as a
string literal, and therefore I cannot substitute Date(), or Now()
etc.. at the end of the string..so example being
Blah_Report_01012006.xls, and the date changes each time it is ran.

2. I have a default sheet being created/formatted through a macro and
then select values being cut.pasted over from another sheet, I have to
do this b/c the cells being copied are the SUMs from question D in the
previous. My problem is that everytime this report is ran, the cells
where the subtotal values are, will be changing, so I need code where
it recognizes the value as a subtotal and not just a number, then copy
that into the default sheet into the cells I have already designated.
Because there are going to be mutliple instances of sums, I am having a
hard time figuring out how to make sure excel keeps it all straight.

let me know if you have further questions, and thanks again for any
help.

JLatham wrote:
Here is macro coding for the 1st 4 requests, all assume that the data of
interest is in column A - declared by constant SearchColumn in each routine:

A - Split at numeric changes
Sub SplitAtNewNumber()
Const SearchColumn = "A" ' change as needed
Dim LastNum As Long ' change type if needed
Dim CurrentNum As Long ' change type if needed

'go to first cell with number in it
Range(SearchColumn & "1").Select
'initialize values
LastNum = ActiveCell.Value
Application.ScreenUpdating = False
Do Until IsEmpty(ActiveCell)
CurrentNum = ActiveCell.Value
If LastNum CurrentNum Then
'insert column
Selection.EntireRow.Insert
LastNum = CurrentNum
End If
'move down 1 row
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True

End Sub

B - Removing rows with numbers that end with a 5

Sub TestRemoveByDiv5()
Const SearchColumn = "A" ' change as required

'find last row with entry in the column
Range(SearchColumn & "65536").End(xlUp).Select
Application.ScreenUpdating = False ' speeds things up
Do While ActiveCell.Row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
'move up 1 row
ActiveCell.Offset(-1, 0).Activate
Loop
'one last test for row 1
If Right(Str(ActiveCell.Value), 1) = 5 Then
'to remove just the cell & shift others up
Selection.Delete shift:=xlUp
'to delete the entire row
'selection.entirerow.delete
'both leave you at the same row
End If
Application.ScreenUpdating = True
Range("A1").Select

End Sub

C - the cut'n'paste stuff, or Match and Move
Sub MatchAndMoveIt()
Const SearchColumn = "A"
Dim FindResult As Range
Dim SearchFor As String

SearchFor = InputBox("Enter Search Phrase", "Begin Move", "nothing")
If SearchFor = "nothing" Then
Exit Sub
End If
Application.ScreenUpdating = False
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)

Do Until FindResult Is Nothing
Range(FindResult.Address & ":" &
Range(FindResult.Address).End(xlToRight).Address). Select
Selection.Cut
Worksheets("MatchAndMove2").Select
Range("A65536").End(xlUp).Select
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(1, 0).Activate
End If
ActiveSheet.Paste
Worksheets("MatchAndMove1").Select
Set FindResult = Range(SearchColumn & ":" &
SearchColumn).Find(SearchFor, _
LookIn:=xlValues, LookAt:=xlWhole)
Loop
Range(SearchColumn & "1").Select
Application.ScreenUpdating = True

End Sub

D - the sum numbers to blank cell part:
Sub CalcGroupsToEmpties()
Const SearchColumn = "A"
Dim GroupTotal As Single ' floating point
Dim LastRowToSearch As Long

LastRowToSearch = Range(SearchColumn & "65536").End(xlUp).Row + 1
Range(SearchColumn & "1").Select ' 1st row with value in it

Do Until ActiveCell.Row LastRowToSearch
GroupTotal = 0
Do Until IsEmpty(ActiveCell)
GroupTotal = GroupTotal + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell = GroupTotal
ActiveCell.Offset(1, 0).Activate
Loop

End Sub

I've not provided E - little complex here, don't know whether you'd prefer
to use DAO or ADO or what to control Access.
If it were me I'd open up an instance of Access and open the MDB and use the
DLOOKUP() functin inside of access to return your description and replace the
search parameter with the returned value.

Hopefully the hours saved with 4 solutions will give you the time needed to
do the Access interface portion. You could even consider exporting the
appropriate table or query result to an Excel worksheet and put that into
your Excel workbook and use VLOOKUP() or similar function to get the data you
need.

"schaapiee" wrote:

I am looking for VB script to accomplish the requests below.

A. I need to be able to compare the numbers with the one above it, and
insert a row if the numbers are not the same..
BEFORE
01 01
01 01
01 01
02
02 02
02

B. If I have a column of numbers 12345, 11000, 11045, and so forth, I
want to be able to search the sheet for the items in this column and
remove the row of data if it ends in "5"
ie. ****5

C. I also want to do a search for the name column, return all values
where this is true, then cut the rows/columns where this is true into a
new sheet/or .xls file
ie.
wyoming 01 free blue
wyoming 02 free red
kansas 01
....this function would cut/paste the four columns and two or more rows
where I search for the word "wyoming"

D. I want to calculate a sum until it meets a row with a space,
calcthesum, the move down, calc next sum, etc..

E. I have a couple tables in Access, and want to replace values in
excel with corresponding values in Access.
ie. ID 16455 in excel
ID 16455, desc blahblah in Access
ID blahblah in excel after replace..

Thanks for helping me by addressing any of these issues, figured it
would be faster to go this route as I could be looking in the help's
for hours.
~schaapiee