Ugly Macro - Duplicates/Non Numbers/Fill Down

  • Thread starter Thread starter foolio
  • Start date Start date
F

foolio

Okay I get price lists from manufacturers and need to turn them into a
standard format.

The general formatting I have a macro for, column widths, formats,
alignments, text sizes yada yada yada...

But here are a few extras that I would REALLY like to have in the
macro.

1) I would like the macro to insert 999999 into column C whenever there
is a part number in column A.

2) I would like the macro to check column h for anything other than a
number (column h is for prices and sometimes they put POA or NA, i cant
have this) and when it find something that isnt a number put "Error in
H" into column M

3) do the same thing for column K but "Error in K" in column M

4) same thing for column F but "Error in F" in column M

5) I would also like the macro to sort by the first row (part numbers)
and check for duplicates and throw a "Duplicate" into column M whenever
it finds one

6) and of course it would be really nice if the errors would
concatenate in M so they dont just overwrite each other.

Whoever figures this one out for me will have there name held in glory
for the next 3 days (then i go on holidays !) and then when i get back
everytime i use there macro :D
 
Quickly before I must edit my next price list lol

*cough cough* sorry for that ever so subtle bum
 
I think I'd just plop a few worksheet functions into your worksheet.

If you agree:

Option Explicit
Sub testme()

Dim LastRow As Long
Dim FirstRow As Long
Dim wks As Worksheet
Dim dummyRng As Range

Set wks = ActiveSheet
With wks
Set dummyRng = .UsedRange 'try to reset last cell
FirstRow = 2 'headerrows???
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

With .Range(.Cells(FirstRow, "A"), .Cells(LastRow, "L"))
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

With .Range(.Cells(FirstRow, "C"), .Cells(LastRow, "C"))
.FormulaR1C1 = "=IF(RC[-2]="""","""",999999)"
' .Value = .Value
End With

With .Range(.Cells(FirstRow, "M"), .Cells(LastRow, "M"))
.FormulaR1C1 = "=TRIM(IF(ISTEXT(RC[-5]),"" Error in H"","""")" _
& "&IF(ISTEXT(RC[-2]),"" Error in K"","""")" _
& "&IF(ISTEXT(RC[-7]),"" Error in F"","""")" _
& "&IF(COUNTIF(R" & FirstRow & "C1:R" _
& LastRow & "C1,RC[-12])>1,"" Duplicate"",""""))"
'.Value = .Value
End With

End With

End Sub
 
Seems to work like a charm dave.... actually froze my workbook the firs
time i tried to run it but i think i know why.

Now I just have to add all of the easy stuff to it and WooT WooT !!

Thanks you very very very very VERY much Dave
 
I am having problems putting the two macros together.....

here is the one i have for formatting columns and text and what not...

Sub MarcoONNNE()
'
' MarcoONNNE Macro
' Macro recorded 7/8/2004 by User
'

'
ActiveWindow.Zoom = 100
Columns("A:A").Select
Selection.ColumnWidth = 20
Columns("B:B").Select
Selection.ColumnWidth = 26
Columns("C:C").Select
Selection.ColumnWidth = 6
Columns("D:D").Select
Selection.ColumnWidth = 5
Columns("E:E").Select
Selection.ColumnWidth = 3
Columns("F:F").Select
Selection.ColumnWidth = 4
Columns("G:G").Select
Selection.ColumnWidth = 20
Columns("H:H").Select
ActiveWindow.SmallScroll ToRight:=3
Columns("H:L").Select
Selection.ColumnWidth = 10
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("G:G").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveWindow.SmallScroll ToRight:=-3
Columns("F:F").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("D:E").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("A:B").Select
Range("B1").Activate
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.NumberFormat = "@"
Columns("C:C").Select
Selection.NumberFormat = "0"
Columns("D:E").Select
Selection.NumberFormat = "@"
Columns("F:F").Select
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0"
Columns("G:G").Select
Selection.NumberFormat = "@"
ActiveWindow.LargeScroll ToRight:=1
ActiveWindow.ScrollColumn = 4
Columns("H:L").Select
Selection.NumberFormat = "0.000"
ActiveWindow.LargeScroll ToRight:=-1
Cells.Select
Selection.EntireColumn.Hidden = False
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 1
Selection.RowHeight = 12.75
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
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
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
Columns("D:D").Select
Selection.NumberFormat = "General"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=UPPER(RC[-1])"
Range("B1:B65535").Select
Selection.FillDown
ActiveWindow.ScrollRow = 1
Range("D1").Select
ActiveCell.FormulaR1C1 = "=UPPER(RC[-1])"
Range("D1:D65535").Select
Selection.FillDown
ActiveWindow.ScrollRow = 1
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.NumberFormat = "@"
Columns("B:B").Select
Selection.NumberFormat = "@"
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("D4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
End Sub




Could you please tell me how to combine this one with the one you sent
me ? I tried a couple times and tried to run it but it just keeps
running and eventually stops responding :S :S :S
 
The easiest way is to just put a call to it at the end of your sub:


.....

Call Testme 'change that name to something more meaningful!

End Sub

But recorded macros can get cleaned up. You can eliminate a lot of duplicate
processes by combining stuff. And you can clean up the false steps you made
when you were recording the macro.

Use the following against test data! I think I got everything, but there's no
test like real data.

Option Explicit
Sub MacroTwooooooo()

Dim LastRow As Long

With ActiveSheet

'I used the data in column A to determine the lastrow
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

.Range("A:A").ColumnWidth = 20
.Range("B:B").ColumnWidth = 26
.Range("C:C").ColumnWidth = 6
.Range("D:D").ColumnWidth = 5
.Range("E:E").ColumnWidth = 3
.Range("F:F").ColumnWidth = 4
.Range("G:G").ColumnWidth = 20
.Range("H:L").ColumnWidth = 10

With .Range("C:F,H:L")
.HorizontalAlignment = xlRight
End With

With .Range("A:b,G:G")
.HorizontalAlignment = xlLeft
End With

.Range("A:B,D:E,G:G").NumberFormat = "@"
.Range("C:C,f:F").NumberFormat = "0"
.Range("H:L").NumberFormat = "0.000"

With .Cells
.EntireColumn.Hidden = False
With .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
.RowHeight = 12.75

.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone

End With

.Range("C:C").Insert
.Range("B:B").Insert
.Range("b:B,d:d").NumberFormat = "General"

.Range("B1:b" & LastRow).FormulaR1C1 = "=UPPER(RC[-1])"
.Range("D1:D" & LastRow).FormulaR1C1 = "=UPPER(RC[-1])"

'here's two ways to convert from formulas to values
'I've used both--use the one you like best.
With .Range("B:B")
.Value = .Value
End With

With .Range("D:D")
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With

.Range("a:A").Delete
.Range("B:B").Delete
.Range("A:B").NumberFormat = "@"

'or .value = .value
With .Cells
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With

.Range("D4").ClearContents

End With

Call Testme 'change that name to something more meaningful!

End Sub

About the only significant thing I did (besides adding lots of with/end with's)
is to determine the lastrow. That way you don't have to copy the formula down
to row 65536. I used the data in column A for this. If column A doesn't always
have data for each used row, you'll have to adjust this.

If you're going to select all the cells and adjust the settings, you don't need
to do it for each column--one at a time.


foolio < said:
I am having problems putting the two macros together.....

here is the one i have for formatting columns and text and what not...

Sub MarcoONNNE()
'
' MarcoONNNE Macro
' Macro recorded 7/8/2004 by User
'

'
ActiveWindow.Zoom = 100
Columns("A:A").Select
Selection.ColumnWidth = 20
Columns("B:B").Select
Selection.ColumnWidth = 26
Columns("C:C").Select
Selection.ColumnWidth = 6
Columns("D:D").Select
Selection.ColumnWidth = 5
Columns("E:E").Select
Selection.ColumnWidth = 3
Columns("F:F").Select
Selection.ColumnWidth = 4
Columns("G:G").Select
Selection.ColumnWidth = 20
Columns("H:H").Select
ActiveWindow.SmallScroll ToRight:=3
Columns("H:L").Select
Selection.ColumnWidth = 10
With Selection
HorizontalAlignment = xlRight
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
ShrinkToFit = False
MergeCells = False
End With
Columns("G:G").Select
With Selection
HorizontalAlignment = xlLeft
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
MergeCells = False
End With
ActiveWindow.SmallScroll ToRight:=-3
Columns("F:F").Select
With Selection
HorizontalAlignment = xlRight
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
ShrinkToFit = False
MergeCells = False
End With
Columns("D:E").Select
With Selection
HorizontalAlignment = xlLeft
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
MergeCells = False
End With
Columns("C:C").Select
With Selection
HorizontalAlignment = xlRight
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
ShrinkToFit = False
MergeCells = False
End With
Columns("A:B").Select
Range("B1").Activate
With Selection
HorizontalAlignment = xlLeft
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
MergeCells = False
End With
Selection.NumberFormat = "@"
Columns("C:C").Select
Selection.NumberFormat = "0"
Columns("D:E").Select
Selection.NumberFormat = "@"
Columns("F:F").Select
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0"
Columns("G:G").Select
Selection.NumberFormat = "@"
ActiveWindow.LargeScroll ToRight:=1
ActiveWindow.ScrollColumn = 4
Columns("H:L").Select
Selection.NumberFormat = "0.000"
ActiveWindow.LargeScroll ToRight:=-1
Cells.Select
Selection.EntireColumn.Hidden = False
With Selection.Font
Name = "Arial"
FontStyle = "Regular"
Size = 10
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
ColorIndex = 1
End With
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 1
Selection.RowHeight = 12.75
With Selection
HorizontalAlignment = xlGeneral
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
ShrinkToFit = False
MergeCells = False
End With
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
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
Columns("D:D").Select
Selection.NumberFormat = "General"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=UPPER(RC[-1])"
Range("B1:B65535").Select
Selection.FillDown
ActiveWindow.ScrollRow = 1
Range("D1").Select
ActiveCell.FormulaR1C1 = "=UPPER(RC[-1])"
Range("D1:D65535").Select
Selection.FillDown
ActiveWindow.ScrollRow = 1
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.NumberFormat = "@"
Columns("B:B").Select
Selection.NumberFormat = "@"
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("D4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
End Sub

Could you please tell me how to combine this one with the one you sent
me ? I tried a couple times and tried to run it but it just keeps
running and eventually stops responding :S :S :S
Click to expand...
 
I actually just got it working lol...although I must say yours look
much neater... now there is only one thing I would like to add...

actually i wanted to sort it so the errors were all at the top....eas
easy...

but i also want to delete all the blank cells at the end that
sometimes get from suppliers ? any idea on how to do that
 
Can you use a column to indicate a blank row (guessing you really meant row).

If yes, try this

Select column A.
Edit|goto|special|blanks
rightclick on one of the selected cells and choose delete (and then entire row).

Record a macro and you'll see the code looks something like:

Sub Macro2()
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Range("B16").Select
End Sub

But we could fix it up!

Sub macro2a()
ActiveSheet.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
end sub

And just in case there aren't any blanks:

sub macro3a()
on error resume next
ActiveSheet.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
Hey Dave back to this code.... I am having troubles with it .... If yo
could just look over it it would be greatly appreciated

Option Explicit
'Written by Dave Peterson @ www.excelforum.com
'Search for username Foolio

Sub Master_Stock_Macro()

Dim LastRow As Long

With ActiveSheet

'Finds the last row of data according to column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'Sets Column Widths
.Range("A:A").ColumnWidth = 20
.Range("B:B").ColumnWidth = 26
.Range("C:C").ColumnWidth = 6
.Range("D:D").ColumnWidth = 5
.Range("E:E").ColumnWidth = 3
.Range("F:F").ColumnWidth = 4
.Range("G:G").ColumnWidth = 20
.Range("H:L").ColumnWidth = 10

'Sets Left Alignments
With .Range("A:B,D:E,G:G")
.HorizontalAlignment = xlLeft
End With

'Sets Right Alignments
With .Range("C:C,F:F,H:L")
.HorizontalAlignment = xlRight
End With

'Sets the Formats
.Range("A:B,D:E,G:G").NumberFormat = "@"
.Range("C:C,F:F").NumberFormat = "0"
.Range("H:L").NumberFormat = "0.000"

'Sets the zoom to 100%
ActiveWindow.Zoom = 100

'Takes out splits and frozen panes
With ActiveWindow
.SplitColumn = 0
.SplitRow = 0
.FreezePanes = False
End With

'Sets a whole bunch of properties for all cells
With .Cells
.EntireColumn.Hidden = False
With .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
.RowHeight = 12.75
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

'Inserts a column after column A and B
.Range("C:C").Insert
.Range("B:B").Insert
.Range("B:B,D:D").NumberFormat = "General"

'Insert the uppercase text into the new columns
.Range("B1:B" & LastRow).FormulaR1C1 = "=UPPER(RC[-1])"
.Range("D1:D" & LastRow).FormulaR1C1 = "=UPPER(RC[-1])"

'Converts formulas to values in the new columns
With .Range("B:B,D:D")
.Value = .Value
End With

'Deletes the old columns with the lowercase letters
.Range("A:A").Delete
.Range("B:B").Delete

'Resets the formats for the new columns
.Range("A:B").NumberFormat = "@"

'Fills column C down with 999999
With .Range(.Cells(1, "C"), .Cells(LastRow, "C"))
.FormulaR1C1 = "=IF(RC[-2]="""","""",999999)"
.Value = .Value
End With

'Fills column E down with "N"
With .Range(.Cells(1, "E"), .Cells(LastRow, "E"))
.FormulaR1C1 = "=IF(RC[-2]="""","""",N)"
.Value = .Value
End With

'Clears contents of Column D,G,I,J,L
.Range("D:D,G:G,I:J,L:L").ClearContents

'Sorts by Column A (part number) so we can look for duplicates
With .Range(.Cells(1, "A"), .Cells(LastRow, "L"))
.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
End With

'Here I would like a code that checks for errors as per the lis
that follows
'The errors would be reported in Column M
'Note that the errors should add on to each other, not overwrite

'Column A may not contain duplicates, error message is "Duplicat
in A"
'Column B may not be blank, error message is "Error in B"
'Column F must be a number with no decimal or be blank, erro
message is "Error in F"
'Column H must be a number with 3 decimals, error message is "Erro
in H"
'Column K must be a number with 3 decimals, error message is "Erro
in K"

'Sorts by Column M (errors) so the errors are all at the top
With .Range(.Cells(1, "A"), .Cells(LastRow, "L"))
.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
End With

'Sets your view to the top of Column M so the errors stand out
Range("m1").Select

End With
End Su
 
Without looking at all the existing code, how about:

With .Range(.Cells(1, "M"), .Cells(LastRow, "M"))
.Formula = "=trim(" _
& "if(countif(a:a,a1)>1, ""Duplicate in A "","""")" _
& "&if(b1="""",""Error in B "","""")" _
& "&IF(INT(N(F1))=F1,"""",""Error in F "")" _
& "&if(1000*int(n(H1))=1000*h1,"""",""Error in H "")" _
& "&if(1000*int(n(k1))=1000*k1,"""",""Error in K "")" _
& ")"
'.Value = .Value
End With

But for those cells that have 3 decimal places, 3.000 (also equal to 3) will be
marked as ok.



foolio < said:
Hey Dave back to this code.... I am having troubles with it .... If you
could just look over it it would be greatly appreciated

Option Explicit
'Written by Dave Peterson @ www.excelforum.com
'Search for username Foolio

Sub Master_Stock_Macro()

Dim LastRow As Long

With ActiveSheet

'Finds the last row of data according to column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'Sets Column Widths
Range("A:A").ColumnWidth = 20
Range("B:B").ColumnWidth = 26
Range("C:C").ColumnWidth = 6
Range("D:D").ColumnWidth = 5
Range("E:E").ColumnWidth = 3
Range("F:F").ColumnWidth = 4
Range("G:G").ColumnWidth = 20
Range("H:L").ColumnWidth = 10

'Sets Left Alignments
With .Range("A:B,D:E,G:G")
HorizontalAlignment = xlLeft
End With

'Sets Right Alignments
With .Range("C:C,F:F,H:L")
HorizontalAlignment = xlRight
End With

'Sets the Formats
Range("A:B,D:E,G:G").NumberFormat = "@"
Range("C:C,F:F").NumberFormat = "0"
Range("H:L").NumberFormat = "0.000"

'Sets the zoom to 100%
ActiveWindow.Zoom = 100

'Takes out splits and frozen panes
With ActiveWindow
SplitColumn = 0
SplitRow = 0
FreezePanes = False
End With

'Sets a whole bunch of properties for all cells
With .Cells
EntireColumn.Hidden = False
With .Font
Name = "Arial"
FontStyle = "Regular"
Size = 10
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
ColorIndex = 1
End With
Interior.ColorIndex = xlNone
Font.ColorIndex = 1
RowHeight = 12.75
HorizontalAlignment = xlGeneral
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
ShrinkToFit = False
MergeCells = False
Borders(xlDiagonalDown).LineStyle = xlNone
Borders(xlDiagonalUp).LineStyle = xlNone
Borders(xlEdgeLeft).LineStyle = xlNone
Borders(xlEdgeTop).LineStyle = xlNone
Borders(xlEdgeBottom).LineStyle = xlNone
Borders(xlEdgeRight).LineStyle = xlNone
Borders(xlInsideVertical).LineStyle = xlNone
Borders(xlInsideHorizontal).LineStyle = xlNone
End With

'Inserts a column after column A and B
Range("C:C").Insert
Range("B:B").Insert
Range("B:B,D:D").NumberFormat = "General"

'Insert the uppercase text into the new columns
Range("B1:B" & LastRow).FormulaR1C1 = "=UPPER(RC[-1])"
Range("D1:D" & LastRow).FormulaR1C1 = "=UPPER(RC[-1])"

'Converts formulas to values in the new columns
With .Range("B:B,D:D")
Value = .Value
End With

'Deletes the old columns with the lowercase letters
Range("A:A").Delete
Range("B:B").Delete

'Resets the formats for the new columns
Range("A:B").NumberFormat = "@"

'Fills column C down with 999999
With .Range(.Cells(1, "C"), .Cells(LastRow, "C"))
FormulaR1C1 = "=IF(RC[-2]="""","""",999999)"
Value = .Value
End With

'Fills column E down with "N"
With .Range(.Cells(1, "E"), .Cells(LastRow, "E"))
FormulaR1C1 = "=IF(RC[-2]="""","""",N)"
Value = .Value
End With

'Clears contents of Column D,G,I,J,L
Range("D:D,G:G,I:J,L:L").ClearContents

'Sorts by Column A (part number) so we can look for duplicates
With .Range(.Cells(1, "A"), .Cells(LastRow, "L"))
Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
End With

'Here I would like a code that checks for errors as per the list
that follows
'The errors would be reported in Column M
'Note that the errors should add on to each other, not overwrite

'Column A may not contain duplicates, error message is "Duplicate
in A"
'Column B may not be blank, error message is "Error in B"
'Column F must be a number with no decimal or be blank, error
message is "Error in F"
'Column H must be a number with 3 decimals, error message is "Error
in H"
'Column K must be a number with 3 decimals, error message is "Error
in K"

'Sorts by Column M (errors) so the errors are all at the top
With .Range(.Cells(1, "A"), .Cells(LastRow, "L"))
Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
End With

'Sets your view to the top of Column M so the errors stand out
Range("m1").Select

End With
End Sub
Click to expand...
 
Hrm.... definetly having some problems

With .Range(.Cells(1, "M"), .Cells(LastRow, "M"))
.Formula = "=trim(" _
& "if(countif(a:a,a1)>1, ""Duplicate in A "","""")" _
& "&if(b1="""",""Error in B "","""")" _
& "&IF(INT(N(F1))=F1,"""",""Error in F "")" _
& "&if(1000*int(n(H1))=1000*h1,"""",""Error in H "")" _
& "&if(1000*int(n(k1))=1000*k1,"""",""Error in K "")" _
& ")"
'.Value = .Value
End With

what is the point of '.Value = .Value .... its just a comment ?
I guess i could just take out the comment and it would get rid of th
formulae and turn them into values....

now the important things

Column B: the description actually copies the first part number (A1)
all the way down to line 65532 instead of just taking the ol
description (B) and making it uppercase

Column E: it inserts =IF(RC[-2]="","",N) instead of just an N

those are the two that i cant really figure out...
 
..value = .value converts that range to values. It removes the formulas and
means that if you change the data, the value won't change.

From your previous post:

With .Range(.Cells(1, "E"), .Cells(LastRow, "E"))
.FormulaR1C1 = "=IF(RC[-2]="""","""",N)"
.Value = .Value
End With

That N looks kind of bare to me. Maybe:

With .Range(.Cells(1, "E"), .Cells(LastRow, "E"))
.FormulaR1C1 = "=IF(RC[-2]="""","""",""N"")"
.Value = .Value
End With

As for column B, your code looks ok to me (converting to uppercase, then to
values).

If the LastRow is actually 65532 and you didn't expect it to be that big a
number, maybe you have something in column that this line uses:

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

You may to try it manually:
select A65536, hit the End key, hit the up arrow
what row did you stop on?

What was in that cell where you stopped?

If it looked empty, check the formula bar. If you have formulas, they count as
used cells.

If you had a formula that evaluated to "" and then you converted to values, then
excel sees that cell as non-empty.

If you know that you have nothing but contstants in column A (no formulas at
all!), then you can clean up those "" converted to values with something like:

With Worksheets("whateverthenameis").Range("a:A")
.Value = .Value
End With



foolio < said:
Hrm.... definetly having some problems

With .Range(.Cells(1, "M"), .Cells(LastRow, "M"))
Formula = "=trim(" _
& "if(countif(a:a,a1)>1, ""Duplicate in A "","""")" _
& "&if(b1="""",""Error in B "","""")" _
& "&IF(INT(N(F1))=F1,"""",""Error in F "")" _
& "&if(1000*int(n(H1))=1000*h1,"""",""Error in H "")" _
& "&if(1000*int(n(k1))=1000*k1,"""",""Error in K "")" _
& ")"
'.Value = .Value
End With

what is the point of '.Value = .Value .... its just a comment ?
I guess i could just take out the comment and it would get rid of the
formulae and turn them into values....

now the important things

Column B: the description actually copies the first part number (A1)
all the way down to line 65532 instead of just taking the old
description (B) and making it uppercase

Column E: it inserts =IF(RC[-2]="","",N) instead of just an N

those are the two that i cant really figure out....
Click to expand...
 
In a private message:

Okay, I'm sorry about being such a pain and sending all the messages, mainly
ignore all the other ones but this one. I figured it all out except the errors
arent quite what i was looking for. I would try to do this one on my own but
this set of code is totally beyond my understanding of vb

With .Range(.Cells(1, "M"), .Cells(LastRow, "M"))
.Formula = "=trim(" _
& "if(countif(a:a,a1)>1, ""Duplicate in A "","""")" _
& "&if(b1="""",""Error in B "","""")" _
& "&IF(INT(N(F1))=F1,"""",""Error in F "")" _
& "&if(1000*int(n(H1))=1000*h1,"""",""Error in H "")" _
& "&if(1000*int(n(k1))=1000*k1,"""",""Error in K "")" _
& ")"
'.Value = .Value
End With


Column A, Check for duplicates

IE
column a, column m
01-a-003, duplicate in a
01-a-003, duplicate in a

Column B, cannot be blank if there is something in column A

Column F, Must be a number

IE
column f, column m
1 pkg, error in F
case, error in F

Column K, Must be a number

IE
column k, column m
1.1.1, error in k
POA, error in k
-, error in k

Column H - same as above (column K)

============
Try this version:

With .Range(.Cells(1, "M"), .Cells(LastRow, "M"))
.Formula = "=trim(" _
& "if(countif(a:a,a1)>1, ""Duplicate in A "","""")" _
& "&if(and(a1<>"""",b1=""""),""Error in B "","""")" _
& "&IF(isnumber(f1),"""",""Error in F "")" _
& "&if(isnumber(h1),"""",""Error in H "")" _
& "&if(isnumber(k1),"""",""Error in K "")" _
& ")"
'.Value = .Value
End With

The resulting formula in the cell (M1) would look like this:

=TRIM(
IF(COUNTIF(A:A,A1)>1, "Duplicate in A ","")
&IF(AND(A1<>"",B1=""),"Error in B ","")
&IF(ISNUMBER(F1),"","Error in F ")
&IF(ISNUMBER(H1),"","Error in H ")
&IF(ISNUMBER(K1),"","Error in K ")
)

I added line breaks for readability. You can see that each check that you
wanted is on a separate line in the formula (and in the code that creates the
formula).

If you need to update portions of the formula, figure it out on the worksheet
first. Just use the portion that you really need to change--don't fiddle with
all of it.

Then when you get that little portion working, copy it from the formulabar (from
M1) and paste it into the code.

You'll have to double up the quotes (" become ""), replace the leading equal
sign with an ampersand (&) and surround it in quotes.

Just try to duplicate the format that worked for one portion of the formula.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Finding Duplicate Rows (Macro) 2
How to copy a range of cells and paste into a new workbook in differentcolumns 3
Copy Multiple non adjacent columns from one Worksheet to another 6
Sum Total 2
Macro using CLEAN & PROPER on a worksheet. 1
Duplicate Entries 3
Mandatory cells only if another cell is filled 0
Duplicates Deletion ? 2

Back
Top