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