Macro Help

CAW

Board Regular
Joined
Jul 1, 2004
Messages
173
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. :)
Code:
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.
 

Some videos you may like

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, CAW,

this is the part which is replacing double spaces with nothing, so deleting double spaces
just substitute this
Code:
    Cells.Replace What:="  ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
to this
Code:
    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)

Code:
    Range("A1:A2").Select
    Selection.EntireRow.Insert
Code:
    Range("A1:A2").EntireRow.Insert
...........
Code:
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "Last Bid"
Code:
    Range("K4") = "Last Bid
"
...........
Code:
        Cells(65536, 1).Select
        Selection.End(xlUp).Select
        LastRow = ActiveCell.Row
Code:
        LastRow = Cells(65536, 1).End(xlUp).Row
...........
Code:
    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 :confused:
Code:
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False
..........
 

Watch MrExcel Video

Forum statistics

Threads
1,122,952
Messages
5,599,033
Members
414,275
Latest member
Pungie

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top