Simple VBA recording Macro solutions required please - Microsoft Community

hello,

i've been developing macro perform repetitive key strokes , functions when analyzing daily inventory report, simple tasks proving difficult.

these include...

1. being able highlight specific column of data without whole sheet being highlighted?

2. being able delete or hide column of data, without whole sheet's data being removed?

3. being able delete row when contains part number no longer relevant?

the key part number in column b of attached have highlighted in red in sheet 2.

i have attached spreadsheet 3 sheets , vba code far.

sheet 1 raw data

sheet 2 result after macro has been run - including codes in red want delete these rows

sheet 3 end result desperately trying to, includes deleting column u (currency), hiding column g (rtv) highlighting various columns , deleting various rows contain obsolete part number.

oh dear, realized can't add attachments.  okay, can please vba code these operations please because macro recorder in excel won't record i'm doing , run correctly next time.  

i hope can help.

thank you

suzanne

i need way of adding each part number vba code such can identified , removed.  there div errors on part numbers need remain there.

i suggest create sheet named setup (in main file contains macro... if have any) , write numbers in column picture shows:

then switch data sheet (sheet1 in different file) , execute inventory macro (from main file).

andreas.

option explicit

sub inventory()
  const headings string = "lab,stores,obs,rtv,onhand,jobs,net,rop,weekly,12wk,52wk,price,po#,rel#,due date,w.o.h,w.o.h bond,ordered,quantity due"
  dim data, del
  dim range, range, r range, range
  dim long

  'delete curreny
  columns("u").delete
 
  'split headings comma , flush row 5
  data = split(headings, ",")
  range("d5").resize(, ubound(data) + 1).value = data
  'format headings
  rows(5)
    .font.bold = true
    .horizontalalignment = xlleft
  end with
 
  'get part_number delete
  thisworkbook.sheets("setup")
    data = .range("a2", .range("a" & .rows.count).end(xlup))
    if not isarray(data) then
      data = array()
    end if
  end with
  'find rows delete
  = 1 ubound(data)
    set = findall(columns("b"), data(i, 1))
    if not nothing then
      if nothing set = else set = union(all, this)
    end if
  next
  if not nothing all.entirerow.delete
 
  'refer data cells below row 5
  set = range("a5").currentregion
  if where.row < 5 set = where.resize(where.rows.count - 5).offset(5)
 
  'setup colors
  range("h5").interior.color = 10092543
  range("i5").interior.color = 15261367
  range("l5").interior.color = 12379352
  range("s5").interior.color = 10213316
  range("t5").interior.color = 3969910
  'fill colors down
  each r in range("h5,i5,l5,s5,t5")
    intersect(r.entirecolumn, where).interior.color = r.interior.color
  next
 
  'fill formulas
  range("s6").formula = "=h6/l6"
  range("t6").formula = "=v6/l6"
  'down till end of data
  set = intersect(range("s:t"), where)
  this.filldown
 
  'appy autofilter
  where.offset(-1).resize(where.rows.count + 1).autofilter
  'adjust columns
  where.entirecolumn.autofit
  'freeze
  range("a6").select
  activewindow.freezepanes = true
end sub

private function findall(byval range, byval what, _
    optional byval after variant, _
    optional byval lookin xlfindlookin = xlvalues, _
    optional byval lookat xllookat = xlwhole, _
    optional byval searchorder xlsearchorder = xlbyrows, _
    optional byval searchdirection xlsearchdirection = xlnext, _
    optional byval matchcase boolean = false, _
    optional byval searchformat boolean = false) range
  'find occurrences of in (windows version)
  dim firstaddress string
  dim c range
  'from fastunion:
  dim stack new collection
  dim temp() range, item
  dim long, j long

  if nothing exit function
  if searchdirection = xlnext , ismissing(after) then
    'set after last cell in return first cell in in front if _
      match what
    set c = where.areas(where.areas.count)
    'bug in xl2010: cells.count produces rte 6 if c whole sheet
    'set after = c.cells(c.cells.count)
    set after = c.cells(c.rows.count * cdec(c.columns.count))
  end if

  set c = where.find(what, after, lookin, lookat, searchorder, _
    searchdirection, matchcase, searchformat:=searchformat)
  if c nothing exit function

  firstaddress = c.address
  do
    stack.add c
    if searchformat then
      'if call function udf , _
        find first cell use instead
      set c = where.find(what, c, lookin, lookat, searchorder, _
        searchdirection, matchcase, searchformat:=searchformat)
    else
      if searchdirection = xlnext then
        set c = where.findnext(c)
      else
        set c = where.findprevious(c)
      end if
    end if
    'can happen if have merged cells
    if c nothing exit do
  loop until firstaddress = c.address

  'fastunion algorithm © andreas killer, 2011:
  'get cells fragments
  redim temp(0 stack.count - 1)
  = 0
  each item in stack
    set temp(i) = item
    = + 1
  next
  'combine each fragment next one
  j = 1
  do
    = 0 ubound(temp) - j step j * 2
      set temp(i) = union(temp(i), temp(i + j))
    next
    j = j * 2
  loop until j > ubound(temp)
  'at point have cells in first fragment
  set findall = temp(0)
end function

Office / Excel / Windows 8 / Office 2010