Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Question
I recently acquired an Excel 2003 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, and I'm at a loss as where to turn for help. ------------------- 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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Question
Here is a (untested) shot
Sub Truequoteformat() 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").EntireRow.Insert Range("A1").Value = "Truequote" Range("A2").Value = "=TODAY()-1" With Rows("1:2") .Font.Bold = True .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .IndentLevel = 0 .ShrinkToFit = False .MergeCells = False End With Range("K4").Value = "Last Bid" Range("L4").Value = "Last Offer" Range("M4").Value = "Average" Range("K5").FormulaR1C1 = "=IF(RC[-8]="""","""",IF(RC[-4]="""","""",RC[-8]))" Range("K5").AutoFill Destination:=Range("K5:L5"), Type:=xlFillDefault Range("L5").FormulaR1C1 = "=IF(RC[-9]="""","""",IF(RC[-5]="""","""",RC[-5]))" Range("M5").FormulaR1C1 = "=IF(RC[-2]="""","""",AVERAGE(RC[-2],RC[-1]))" 'Find last row of data LastRow = Cells(65536, 1).End(xlUp).Row 'Fill columns to last row WorkingRange = "K5:M" & LastRow Range("K5:M5").AutoFill Destination:=Range(WorkingRange), Type:=xlFillDefault Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False Cells.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder:= _ xlByRows, MatchCase:=False Range("K4:M4").Font.Bold = True With Range("K3:M3") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .BorderAround .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone End With With Range("K4:M" & LastRow) .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .BorderAround .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With Range("J1").EntireColumn.Hidden = True Range("N8").Select End Sub -- HTH RP (remove nothere from the email address if mailing direct) "Me" wrote in message ... I recently acquired an Excel 2003 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, and I'm at a loss as where to turn for help. ------------------- 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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Question
What would you like to do with the 0's?
Here is a single line that you can add in at the end that should take care of what you want. You cna change the Replacement:="" with whatever you would like... Cells.Replace What:=0, Replacement:="", LookAt:=xlWhole HTH "Me" wrote: I recently acquired an Excel 2003 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, and I'm at a loss as where to turn for help. ------------------- 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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Question
Hi,
When you are serching for blanks spaces, the code that is doing this is the replace function via: Cells.Replace What:=" ", Replacement:="", so if you want to do it for zeros too I would just add in another similar line for the zero value so each of your your blocks of code would now be e.g Range("D16").Select Selection.Copy Application.CutCopyMode = False Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False Cells.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False Notice it is doing the same relecement separately for the cells D16, E16 and B16 so instaed of having 3 blocks in there for 3 cells you may want to do it once by: Range("B16:E16").Select - assumming you don't mind altering the contents of C16. Hope this solves it Jello. P.S Below is the help information you can access from the VBEditor(Tools, Macro, VBEditor - you will need to access the VBEditor to change your function !) by pressing F2 - go the the range class double click and go to the replace function(green icon) - press the icon to bring up the help file as shown below - this is how you can serach for functions you are using: Replace Method Finds and replaces characters in cells within the specified range. Using this method doesnt change either the selection or the active cell. For information about using the Replace worksheet function in Visual Basic, see Using Worksheet Functions in Visual Basic. Syntax expression.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte) expression Required. An expression that returns a Range object. What Required String. The string you want Microsoft Excel to search for. Replacement Required String. The replacement string. LookAt Optional Variant. Can be one of the following XlLookAt constants: xlWhole or xlPart. SearchOrder Optional Variant. Can be one of the following XlSearchOrder constants: xlByRows or xlByColumns. MatchCase Optional Variant. True to make the search case sensitive. MatchByte Optional Variant. You can use this argument only if youve selected or installed double-byte language support in Microsoft Excel. True to have double-byte characters match only double-byte characters. False to have double-byte characters match their single-byte equivalents. Remarks The settings for LookAt, SearchOrder, MatchCase, and MatchByte are saved each time you use this method. If you dont specify values for these arguments the next time you call the method, the saved values are used. Setting these arguments changes the settings in the Find dialog box, and changing the settings in the Find dialog box changes the saved values that are used if you omit the arguments. To avoid problems, set these arguments explicitly each time you use this method. The replace method always returns True "Me" wrote: I recently acquired an Excel 2003 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, and I'm at a loss as where to turn for help. ------------------- 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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Question
Wow, thanks folks!
Well, that was simple enough, now I'll just need to test it tomorrow, but I'm sure it'll run perfectly. Thanks for everyone's input! :-) "Me" wrote: I recently acquired an Excel 2003 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, and I'm at a loss as where to turn for help. ------------------- 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. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Question
Ok, the macro ran fine with one exception: Any cell references containing a
zero within a formula came back without the zero. An example: Correct: =IF(C639="","",IF(G639="","",C639)) [at line 639] Incorrect: =IF(C64="","",IF(G64="","",C64)) [at line 640] As you can see, line 640's formula is missing the 0, therefore making it refer to line 64. This is the same result for all cell references containg a zero (at the very least, every ten rows). What can be done to aleviate this problem? Thanks again. "Jello" wrote: Hi, When you are serching for blanks spaces, the code that is doing this is the replace function via: Cells.Replace What:=" ", Replacement:="", so if you want to do it for zeros too I would just add in another similar line for the zero value so each of your your blocks of code would now be e.g Range("D16").Select Selection.Copy Application.CutCopyMode = False Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False Cells.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False Notice it is doing the same relecement separately for the cells D16, E16 and B16. "Me" wrote: I recently acquired an Excel 2003 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, and I'm at a loss as where to turn for help. ------------------- 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel 2007 Macro/VB Question DDE Question | Excel Worksheet Functions | |||
Macro Question | Excel Worksheet Functions | |||
Macro Question | Excel Worksheet Functions | |||
Macro Question | New Users to Excel | |||
Macro question | Excel Programming |