Macro Help

[CAW]

I recently acquired an Excel spreadsheet that searches the entire sheet for blank spaces. This execution is done with the help of a macro.

My supervisor now wants me to add more code to the macro that will now include a search for occurrences of zero (0).

I don't really have any coding experience, so I need some assistance. I'm thinking this isn't anything too difficult for you guys to figure out.

Sub Truequoteformat()
'
' Truequoteformat Macro
' Macro recorded 12/1/2003 by Licensed User
'

Dim WorkingRange As String
Dim LastRow As Double

'
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Range("A1:A2").Select
    Selection.EntireRow.Insert
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Truequote"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()-1"
    Rows("1:2").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "Last Bid"
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "Last Offer"
    Range("M4").Select
    ActiveCell.FormulaR1C1 = "Average"
    Range("K5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-8]="""","""",IF(RC[-4]="""","""",RC[-8]))"
    Range("K5").Select
    Selection.AutoFill Destination:=Range("K5:L5"), Type:=xlFillDefault
    Range("K5:L5").Select
    Range("L5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-9]="""","""",IF(RC[-5]="""","""",RC[-5]))"
    Range("M5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",AVERAGE(RC[-2],RC[-1]))"
    
    'Find last row of data
        Cells(65536, 1).Select
        Selection.End(xlUp).Select
        LastRow = ActiveCell.Row
    'Fill columns to last row
        Range("K5:M5").Select
        WorkingRange = "K5:M" & LastRow
        Selection.AutoFill Destination:=Range(WorkingRange), Type:=xlFillDefault
        Range("K5:M" & LastRow).Select
    
    
    Range("D16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Range("E16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Range("B16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False
    ActiveWindow.SmallScroll ToRight:=2
    Range("K4:M4").Select
    Selection.Font.Bold = True
    Range("K3:M3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    
    
    Range("K4:M" & LastRow).Select
    
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Columns("B:J").Select
    Range("J1").Activate
    Selection.EntireColumn.Hidden = True
    Range("N8").Select
End Sub

Thanks in advance for your help.

 

[erik.van.geit]

Hi, CAW,

this is the part which is replacing double spaces with nothing, so deleting double spaces
just substitute this

    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False

to this

    Cells.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False

kind regards,
Erik

PS there is a lot of excesive code here: you macro could be written without all those selections and useless copying to nowhere

A FEW EXAMPLES (substitute first part with second)

    Range("A1:A2").Select
    Selection.EntireRow.Insert

    Range("A1:A2").EntireRow.Insert

...........

    Range("K4").Select
    ActiveCell.FormulaR1C1 = "Last Bid"

    Range("K4") = "Last Bid

"
...........

        Cells(65536, 1).Select
        Selection.End(xlUp).Select
        LastRow = ActiveCell.Row

        LastRow = Cells(65536, 1).End(xlUp).Row

...........

    Range("D16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Range("E16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Range("B16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False

don't think you need any of those "copies" and you will need a good reason to repeat the code three times and then end with this, which is deleting all spaces anyway (also double spaces)
unless this single space is a typo

    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False

..........