Macro needed. not sure where to start

[Gambit]

Hi All,

So i have recently been given a project in which i need to take a range of data and depending on what is in column B then copy that Row to a specified Sheet from within the workbook,

i have been unable to find a Formula to do this and therefore believe this will need to be done with a macro,

i have never created or edited a macro before and would like some assistance with this,

In the first sheet there are 12 Departments, which also have their own sheet,

We use a program that we export data from into an excel file, in which we will copy the data to the second and third sheets, (Incidents and Problems)

What i am trying to do is to find a quick way to copy or move each row into its corresponding Depart/business area's sheet,

Can anyone offer any assistance or help here, as im in over my head,

Thanks,

 

[Thangavel]

Hi All,

So i have recently been given a project in which i need to take a range of data and depending on what is in column B then copy that Row to a specified Sheet from within the workbook,

i have been unable to find a Formula to do this and therefore believe this will need to be done with a macro,

i have never created or edited a macro before and would like some assistance with this,

In the first sheet there are 12 Departments, which also have their own sheet,

We use a program that we export data from into an excel file, in which we will copy the data to the second and third sheets, (Incidents and Problems)

What i am trying to do is to find a quick way to copy or move each row into its corresponding Depart/business area's sheet,

Can anyone offer any assistance or help here, as im in over my head,

Thanks,

Hello Gambit,
Welcome to Chandoo Forum!

In Incidents & Problems sheet there is no data available to workout for you. Can you please populate some data over there & also what would you like to have as an output needed for further help you.

 

[Gambit]

Thank you for your reply,

I have removed some of the data for confidentially reasons.

What i am trying to do is to just copy the full row into the corresponding page for each business area,

so any ones under Buying copy or move into the buying sheet, any for DHL into DHL one, etc,


▬▬▬▬▬▬▬▬▬ Mod edit : thread moved to appropriate forum !

​

 

[Gambit]

I have now updated the Document to include everything it needs, all headers and pages are final,
i would like to be able to create a macro that will search down both the Incident and Problem Sheets and move or copy each row to the Sheet with its title,

is this possible? and how would i go about it?

thank you for your assistance

 

[Kenneth Hobson]

How would that work since the two sheets do not have all the same fields/columns?

 

[Gambit]

hi kenneth .

although the header names appear different the data within the columns for both incident and problems are the same. the fields do align as required.

what I am trying to do with the macro is to port in the data from the incidents sheet and then port in the data from the problems sheet. so that I can see all of the incidents and problems for each business area on it's own respective sheet.

does this make sense?

 

[Kenneth Hobson]

I guess you will see what I mean when you run this. Always test in backup copy of file.

Sub RunFilterSheet()
  FilterSheet "Incidents"
  FilterSheet "Problems"
End Sub

Sub FilterSheet(sht$)
  Dim ws As Worksheet, calc As Integer, a, e, r As Range
  Dim wst As Worksheet
 
  If Not WorkSheetExists(sht) Then Exit Sub
 
  With Application
    calc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
  End With
 
  Set ws = Worksheets(sht)
  With ws
    .AutoFilterMode = False
    a = UniqueArrayByDict(.Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1))
    If Not IsArray(a) Then GoTo EndNow
    On Error GoTo NextE
    For Each e In a
      If .UsedRange.Rows.Count = 1 Then GoTo NextE
      If Len(CStr(e)) = 0 Then GoTo EndNow
      If WorkSheetExists(CStr(e)) = False Then
        Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = e
        Set wst = Worksheets(CStr(e))
        'Add header/column names
        .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)).Copy _
          ActiveSheet.[A1]
      End If
      Set wst = Worksheets(CStr(e))
      .UsedRange.AutoFilter 2, CStr(e)
      Set r = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) _
        .Resize(, .UsedRange.Columns.Count).SpecialCells(xlCellTypeVisible)
      r.Copy wst.Cells(wst.Rows.Count, "A").End(xlUp).Offset(1)
      wst.UsedRange.Columns.AutoFit
      r.Rows.Delete xlUp
NextE:
      .AutoFilterMode = False
    Next e
  End With
 
EndNow:
  With Application
    .CutCopyMode = False
    .Calculation = calc
    .ScreenUpdating = True
    .EnableEvents = True
  End With
End Sub

'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
    Dim ws As Worksheet, wb As Workbook
    If sWorkSheet = "" Or sWorkSheet = vbCr Or sWorkSheet = vbLf Or _
      sWorkSheet = vbCrLf Then GoTo notExists
    On Error GoTo notExists
    If sWorkbook = "" Then
      Set wb = ActiveWorkbook
      Else
      Set wb = Workbooks(sWorkbook) 'sWorkbook must be open already.  e.g. ken.xlsm, not x:\ken.xlsm.
    End If
    Set ws = wb.Worksheets(sWorkSheet)
    WorkSheetExists = True
    Exit Function
notExists:
    WorkSheetExists = False
End Function

' http://www.excelforum.com/excel-programming-vba-macros/819998-filter-and-sort-scripting-dictionary.html
'Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d As Variant, Optional compareMethod As Integer = 0) As Variant
  Dim dic As Object 'Late Binding method - Requires no Reference
  Set dic = CreateObject("Scripting.Dictionary")  'Late or Early Binding method
  'Dim dic As Dictionary    'Early Binding method
  'Set dic = New Dictionary  'Early Binding Method
  Dim e As Variant
  dic.CompareMode = compareMethod
  'BinaryCompare=0
  'TextCompare=1
  'DatabaseCompare=2
  For Each e In Array1d
    If Not dic.Exists(e) Then dic.Add e, Nothing
  Next e
  UniqueArrayByDict = dic.Keys
End Function