Move certain rows to top of worksheet

[jimmyfinch]

Hi, is there a macro to move rows to the top of a worksheet that have certain chars like dashes, perods, commas etc. and change the font colour to red?

Many thanks,

Jim

 

[ClulessChris]

Start by using the macro recorder.
Alt & F11 will display the VBA editor window, so you can see the code generated.

You'll have more success on this forum if you make a start (do as much as you can) yourself.
Then post specific questions to problems that you encounter along the way.

Everybody is somebodys Nutter.

 

[jimmyfinch]

Hi, thanks for replying. I dont know how to do a sort on the data looking for a certain char. If you can tell me how to do this, i will try to record it as a macro.

Many thanks,

Jim

 

[ClulessChris]

Try the InStr Function

If Instr(Range("A1"),"/") <> 0 Then
'    Do Your Stuff
End IF

Everybody is somebodys Nutter.

 

[jimmyfinch]

Hi, i have come up with this which adds some data to a new column, which i can then do a sort by.

[tt]
=IF(ISNUMBER(SEARCH("/",A2)),"Slash",IF(ISNUMBER(SEARCH("(",A2)),"Open Bracket",IF(ISNUMBER(SEARCH(" ",A2)),"Space",IF(ISNUMBER(SEARCH("-",A2)),"Hyphen",""))))
[/tt]

Can this be put into a macro, then get the macro do do a sort?

Thanks,

Jim

 

[ClulessChris]

Are you looking to do this with workshhet functions or VBA Code?

Everybody is somebodys Nutter.

 

[jimmyfinch]

I would like to do it within a macro that i can just run.

Regards.

 

[ClulessChris]

Sub FindSpecChar()
    Dim X           As Long
    For X = 3 To 65536
        With Range("A" & X)
            If InStr(.Value, "/") <> 0 Then
                RunMyRecordedProcess
                
            ElseIf InStr(.Value, "-") <> 0 Then
                RunMyRecordedProcess
                
            ElseIf InStr(.Value, "?") <> 0 Then
                RunMyRecordedProcess
                
            ElseIf InStr(.Value, "\") <> 0 Then
                RunMyRecordedProcess
                
            End With
        End With
    Next
End Sub

Sub RunMyRecordedProcess()
    MsgBox "this is where you move the rows"
End Sub

Everybody is somebodys Nutter.

 

[jimmyfinch]

Hi, i get a compile error end With without With message that pops up. How does it move the rows to the top?

Kindest regards,

Jim

 

[ClulessChris]

Jim

Sorry but you're not going to get a fully written solution here, only help and guidance.

The above is a rought and basic starting point to check all cells in column A.
Yes it's needs some tiyding up, Here's your learning curve.

How does it move the rows to the top?

it doesn't, try the macro recorder and see the code that creates.

Everybody is somebodys Nutter.

 

[jimmyfinch]

Hi, i have got this bit to work

Sub FindSpecChar()
    Dim X           As Long
    'For X = 1 To 65536
    For X = 1 To 1000
        'MsgBox "A" & X
        With Range("A" & X).Select
            If InStr(ActiveCell.Text, "/") <> 0 Then
                'RunMyRecordedProcess
                'MsgBox "/" & X
                Range("A" & X).Select
               Selection.Font.ColorIndex = 3
    
            ElseIf InStr(ActiveCell.Text, "-") <> 0 Then
                'RunMyRecordedProcess
                'MsgBox "-" & X
                Range("A" & X).Select
               Selection.Font.ColorIndex = 3
                
            ElseIf InStr(ActiveCell.Text, "?") <> 0 Then
                'RunMyRecordedProcess
                'MsgBox "?" & X
                Range("A" & X).Select
               Selection.Font.ColorIndex = 3
                
            ElseIf InStr(ActiveCell.Text, "\") <> 0 Then
                'RunMyRecordedProcess
                'MsgBox "\" & X
                Range("A" & X).Select
                Selection.Font.ColorIndex = 3
                
        End If
        End With
    Next
End Sub

I cant seem to figure out now how to put all the items in red to the top.

How would you normally do this with excel?

Many thanks,

Jim

 

[ClulessChris]

I've taken the Select statements back out (genraly to be avoided).

Sub FindSpecChar()
    Dim X           As Long
    
    For X = 1 To 1000
        With Range("A" & X)
            If InStr(.Value, "/") <> 0 Then
                RunMyRecordedProcess X
    
            ElseIf InStr(.Value, "-") <> 0 Then
                RunMyRecordedProcess X
                
            ElseIf InStr(.Value, "?") <> 0 Then
                RunMyRecordedProcess X
                
            ElseIf InStr(.Value, "\") <> 0 Then
                RunMyRecordedProcess X
                
            End If
        End With
    Next
End Sub

Put a routine in for the following saves on duplication in the routine above.
Although we're using a cut and pate of rows here this is genraly to be avoided. and maybe a sort could be used instead.

Sub RunMyRecordedProcess(LRow As Long)
    Range("A" & LRow).Font.ColorIndex = 3
    If LRow > 1 Then
        Rows(LRow).Cut
        Rows("1:1").Insert Shift:=xlDown
    End If
End Sub

Hope this helps

Everybody is somebodys Nutter.

 

[jimmyfinch]

Hi, im almost there! have got it all working, just need to remove all rows out of Column B if the cell is empty, null or has a value of 0.

here is my working code so far...

Sub DeleteUnused()
  

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range


For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

CorrectFormat
End Sub

Sub CorrectFormat()

'Stops the screen from flickering

Application.ScreenUpdating = False

' Removing borders, setting font.

MsgBox "Removing borders, setting font."

    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = False
        
' Set format of Column A to Text.

MsgBox "Set format of Column A to Text."

    'Columns("A:A").Select
    Selection.NumberFormat = "@"

' Removing Invalid Characters - Periods, Commas, Spaces.

MsgBox "Removing Invalid Characters - Periods, Commas, Hyphens, Spaces."

    Cells.Replace What:=".", Replacement:="", lookat:=xlPart, searchorder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=",", Replacement:="", lookat:=xlPart, searchorder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="-", Replacement:="", lookat:=xlPart, searchorder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=" ", Replacement:="", lookat:=xlPart, searchorder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
       
'MsgBox "Detecting Slashes, Dashes, Brackets"
    Dim X           As Long
    Dim Y           As Long
    
    Y = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    'MsgBox Y
    
    For X = 1 To Y
    
    
    ' Delete Rows where Quantity = 0 or NULL

    MsgBox "Delete Rows where Quantity = 0 or NULL"
    
            
            
        End With
        With Range("A" & X).Select
            If InStr(ActiveCell.Text, "/") Or InStr(ActiveCell.Text, "\") <> 0 Then
                'RunMyRecordedProcess
                Selection.Font.ColorIndex = 3
                Range("C" & X).Value = "1"
                
          '  ElseIf InStr(ActiveCell.Text, "-") <> 0 Then
                'RunMyRecordedProcess
          '     Selection.Font.ColorIndex = 3
          '      Range("C" & X).Value = "2"
                
            ElseIf InStr(ActiveCell.Text, "(") Or InStr(ActiveCell.Text, ")") <> 0 Then
                'RunMyRecordedProcess
                Selection.Font.ColorIndex = 3
                Range("C" & X).Value = "3"
        End If
        End With
    Next

' Sort Data by Column C.

MsgBox "Sort Data by Column C."
    
    Columns("A:C").Select
    Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

' Delete Column C
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft

End Sub

 

[cresbydotcom]

if it is just one character or a group (say) whose ASCII number is higher than or lower than your chosen letter (say) then I write it into a formula on a column to the right (eg SEARCH command) and IF statements to put a "10"
in the cell if true and a 1 if not true. Soemtimes I add numbers based on other contents which will be reflected in the sort.

I would not normally use VBA for this unless the criteria for the characters was convoluted. Even then I might use HLOOKUP

Sending spreadsheets with macro by e-mail can freak-out people and virus checkers.