Macro to search multiple sheets for a value, move results to another sheet depending on inputted data

LauraC1984

Board Regular
Joined
Jan 30, 2020
Messages
63
Office Version
  1. 365
Platform
  1. Windows
Hi,
using the input sheet, I need to be able to search for a value in B13 - across multiple sheets - once the value is found. I need the macro to cut the row, and paste it into the sheet name entered into cell C13.
am I best doing this as separate macros, do one that finds and cuts the data and then others to run depending on the value in C13? as the data in c13 could be upto 14 different values/ 14 sheets that it might need pasting onto.
I can do the first bit of the macro, the find value - but then not sure on the coding for cut and paste - and the go to sheet ??? depending on value in c13

Thanks!
Laura
 
Hi
Thanks will try the new bit of code shortly
Sorry, the sheets that the code takes the found row from and pastes it too are both in ascending order by column A, its not the order of the row that needs to change its the position of the new row within the sheet as the sheet needs to be in date order please
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Also I have just noticed that all sheets still have the filter on column C, can this be taken off?
 
Upvote 0
hi, I get an error on row
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
Else
1585576833909.png
 
Upvote 0
hi, I get an error on row
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
Else
View attachment 10162

looks like you attempted to correct your existing code & not copied the updated code I posted

Please delete existing code & Copy All of the following unaltered

VBA Code:
Sub updateJobstatus()
    Dim FilterRange As Range, PasteRange As Range
    Dim FilterCount As Long, UsedRows As Long, FilterColumn As Long
    Dim sh As Worksheet, wsDestination As Worksheet
    Dim Search As String, msg As String
    
    On Error GoTo myerror
    
    With Worksheets("Input")
'search value
        Search = .Range("B13").Value
'paste destination sheet
        Set wsDestination = Worksheets(.Range("C13").Value)
    End With
    
'the column you are searching
    FilterColumn = 3
    
    For Each sh In ThisWorkbook.Worksheets
        Select Case sh.Name
        Case "Input", "Calendar", "List", "2020", wsDestination.Name
'do nothing
        Case Else
            sh.Visible = True
            sh.Range("A1").CurrentRegion.AutoFilter Field:=FilterColumn, Criteria1:=Search
            
            Set FilterRange = sh.AutoFilter.Range
'count filter records
            FilterCount = FilterRange.Columns(FilterColumn).SpecialCells(xlCellTypeVisible).Count - 1
            
            If FilterCount > 0 Then
                With wsDestination
                    UsedRows = WorksheetFunction.CountA(.Cells)
'remove header row
                    If UsedRows > 0 Then Set FilterRange = FilterRange.Offset(1, 0).Resize(FilterRange.Rows.Count - 1)
                    Set PasteRange = .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + IIf(UsedRows = 0, 0, 1), 1)
                End With
                
                With FilterRange
                    With .SpecialCells(xlCellTypeVisible)
'copy filter record(s) to desination sheet
                        .Copy PasteRange
'delete filtered record(s)
                        .EntireRow.Delete xlShiftUp
                    End With
'clear filter
                    .AutoFilter
                End With
                msg = msg & sh.Name & Chr(10)
            End If
            
            sh.Visible = xlSheetHidden
            
'clear object variables from memory
            Set PasteRange = Nothing
            Set FilterRange = Nothing
            
        End Select
        Next sh
        
        SortRange wsDestination
        
myerror:
        If Err <> 0 Then
'report errors
            MsgBox (Error(Err)), 48, "Error"
        Else
            If Len(msg) > 0 Then
                MsgBox "Following Sheets Where Copied" & Chr(10) & msg, 48, "Success"
            Else
                MsgBox "No Matches Found", 48, "Not Records Found"
            End If
        End If
End Sub

You will also need this code to sort Column A of the destination sheet

VBA Code:
Sub SortRange(ByVal sh As Object)
    Dim xlSort As XlSortOrder
    Dim SortField As Range
    
    Set SortField = sh.Range("A1")
    xlSort = xlAscending
    
    sh.UsedRange.Sort Key1:=SortField, Order1:=xlSort, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Sub

Dave
 
Upvote 0
thanks. wheres best to put the sort code? after the sortRange ws destination?
what about hiding all sheets again?
 
Upvote 0
ok, haven't added in the sort section of the code yet
but got a debug of the following on the section -
SortRange wsDestination

1585580434442.png
 
Upvote 0
ok so I add this section to after the SortRange wsDestination? Thanks
 
Upvote 0
Hi Dave
Back at work finally since end of March!
Hope things are ok with you

I have tried your code that you gave me.
But at the moment cant tell if it works as it stops at
MsgBox "No Matches Found", 48, "Not Records Found"
End If

Sub SortRange(ByVal sh As Object)

after the End If and says Compile error: expected end sub

Can you assist please?

Many thanks
 
Upvote 0
All well thanks.

The message means there where no matches found for the filter value(s) - to understand if this is just the case (no matches) or problem with suggested code, it would be helpful if you could place copy of your workbook with some dummy data in a dropbox & provide a link to it here.

Dave
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,981
Members
448,538
Latest member
alex78

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
Back
Top