Your question is pretty open with assumptions. But You can use this to get you started. Copy this to your Personal Macro and work this till you get what you want then you can move it to a WorkBook Open event.
This code assumes that you always want to apply filters to the 1st row of all the worksheets in your book.
Sub FilterHeaders()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Range("a1").AutoFilter
Next ws
End SubLaurieM,
Assuming all 3 macros are built in the same module, declare a variable the that can be used by all the macro's
This way you can update changes made by Macro 1 to be used in Macro 2 and so on.
Ozgrid has a good article on this here ->
VBA Variables Scope and Lifetime
In UserForm3 have you tried something like this
Private Sub UserForm_Initialize()
Dim lRow As Long, lLar As Long, sTest As String
With Worksheets("Data")
lLar = .Cells(Rows.Count, "G").End(xlUp).Row
If lLar > 2 Then
For lRow = 2 To .Cells(Rows.Count, "G").End(xlUp).Row
sTest = .Cells(lRow, "G")
Me.ComboBox2.AddItem sTest
Next lRow
End If
lLar = .Cells(Rows.Count, "H").End(xlUp).Row
If lLar > 2 Then
For lRow = 2 To .Cells(Rows.Count, "H").End(xlUp).Row
sTest = .Cells(lRow, "H")
Me.ComboBox3.AddItem sTest
Next lRow
End If
End With
End SubAfternoon RRigs,
Myself I would load the data into an Array and then use a dictionary to test for duplicates. Far faster if you have allot of data to go through.
That way anytime the next row encounters a duplicate that already exists in the dictionary, you can use the code to move it to another sheet keeping the original.
Would have to see sample of what your trying to accomplish to give better direction considering the age of the original post.
Remove the code ActWsh.Visible=xlsheetvisble and replace it with Worksheets(ActWsh).Visible=xlSheetVisible
Attached is a your OF sheet with two tabs. Tab labeled drop you simply copy and paste the content from your export sheet into.
The code in here should help get you started, I spent about 10 minutes on this so there is not much error handling. I locked the cells A2 and B2 on the Drop sheet, there is no password to unlock it.
Without any examples or code to view, I might suggest some IF statements to solve your final printing needs after the first VBA code completes.
Re: Get this code to work in each individual row and not just one
By single row, you really mean that only cell D3 is being either locked or unlocked correct?
Can it also be assume that cell B3 extends down your entire sheet that your wanting to trigger off of?
Re: VBA Find Copy Paste
The code can be modified to meet your needs, however, would need to see more of a sample to better understand the end results. If it is just making sure that each sheet doesn't have duplicate data, then very easy.
Re: VBA Button to Copy a New Sheet then Copy cells from one worksheet to another
I might suggest to take a look and see if the code name for Sheet4 is actually named the tab that is labeled Sheet4.
You can look in your project drill down or in your Immediate window type
msgbox worksheets("Sheet4").codenameAs for copying, you can eliminate some lines by using
Worksheets("Sheet3").Range("C30:C32").Copy Destination:=Worksheets("Sheet4").Range("D30").ValueRe: VBA Find Copy Paste
See if this will get you started...
Sub transfer()
Dim ws As Worksheet, wsName As Worksheet
Dim lRow As Long, lPaste As Long
Dim sName As String
Set ws = Worksheets("Update Quality Check Data")
With ws
For lRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
sName = .Cells(lRow, 2)
On Error GoTo NoSheettFound
Jumper:
Set wsName = Worksheets(sName)
On Error GoTo 0
lPaste = wsName.Cells(Rows.Count, 3).End(xlUp).Row + 1
.Cells(lRow, 1).Copy Destination:=wsName.Cells(lPaste, 3)
.Cells(lRow, 3).Copy Destination:=wsName.Cells(lPaste, 4)
Next lRow
End With
Exit Sub
NoSheettFound:
Set wsName = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsName.Name = sName
ws.Select
GoTo Jumper
End SubRe: Code need rectification
PasteSpecail isn't something you can use with VLookup in a cell formula to my knowledge, However, you can add to your code and copy the range of Q and then re paste is as pastespecial if trying to strip the formula.
Re: Matching keywords with Product Description
Sorry bout that, Here is the code modified for single word lookup.
Keep in mind, that partial match's are found which I think is what you wanted. So only typing in a few letters for a word for a match will find more results
Sub Elfabb()
Dim vData() As Variant, vFind() As Variant, vPaste() As Variant
Dim lData As Long, lFind As Long
Dim sTest As String
With Worksheets("WksInput")
vData = .Range("B3").Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 2, 3).Value
End With
With Worksheets("WksOutput")
lFind = .Cells(Rows.Count, 6).End(xlUp).Row - 2
If lFind > 1 Then
vFind = .Range("F3").Resize(.Cells(Rows.Count, 6).End(xlUp).Row - 2, 1).Value
Else
ReDim vFind(1 To 1, 1 To 1)
vFind(1, 1) = .Range("F3").Value
End If
lFind = .Cells(Rows.Count, 2).End(xlUp).Row
If lFind > 2 Then .Range("B3:D" & lFind).Delete shift:=xlUp
End With
ReDim vPaste(1 To 3, 1 To 1)
For lData = LBound(vData, 1) To UBound(vData, 1)
sTest = UCase(vData(lData, 3))
For lFind = LBound(vFind, 1) To UBound(vFind, 1)
If InStr(1, sTest, UCase(vFind(lFind, 1)), vbTextCompare) > 0 Then
vPaste(1, UBound(vPaste, 2)) = vData(lData, 2) 'Product Code
vPaste(2, UBound(vPaste, 2)) = vData(lData, 3) 'Product Description
vPaste(3, UBound(vPaste, 2)) = vData(lData, 1) 'Supplier
ReDim Preserve vPaste(1 To 3, 1 To UBound(vPaste, 2) + 1)
End If
Next lFind
Next lData
With Worksheets("WksOutput")
If UBound(vPaste, 2) > 1 Then
.Range("B3").Resize(UBound(vPaste, 2), 3) = Application.WorksheetFunction.Transpose(vPaste)
lFind = .Cells(Rows.Count, 3).End(xlUp).Row
If lFind > 3 Then .Range("B3").Resize(lFind, 3).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
End If
End With
End SubRe: Matching keywords with Product Description
Try this and see if this does what your looking for.
Sub Elfabb()
Dim vData() As Variant, vFind() As Variant, vPaste() As Variant
Dim lData As Long, lFind As Long
Dim sTest As String
With Worksheets("WksInput")
vData = .Range("B3").Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 2, 3).Value
End With
With Worksheets("WksOutput")
vFind = .Range("F3").Resize(.Cells(Rows.Count, 6).End(xlUp).Row - 2, 1).Value
lFind = .Cells(Rows.Count, 2).End(xlUp).Row
If lFind > 2 Then .Range("B3:D" & lFind).Delete shift:=xlUp
End With
ReDim vPaste(1 To 3, 1 To 1)
For lData = LBound(vData, 1) To UBound(vData, 1)
sTest = UCase(vData(lData, 3))
For lFind = LBound(vFind, 1) To UBound(vFind, 1)
If InStr(1, sTest, UCase(vFind(lFind, 1)), vbTextCompare) > 0 Then
vPaste(1, UBound(vPaste, 2)) = vData(lData, 2) 'Product Code
vPaste(2, UBound(vPaste, 2)) = vData(lData, 3) 'Product Description
vPaste(3, UBound(vPaste, 2)) = vData(lData, 1) 'Supplier
ReDim Preserve vPaste(1 To 3, 1 To UBound(vPaste, 2) + 1)
End If
Next lFind
Next lData
With Worksheets("WksOutput")
If UBound(vPaste, 2) > 1 Then
.Range("B3").Resize(UBound(vPaste, 2), 3) = Application.WorksheetFunction.Transpose(vPaste)
lFind = .Cells(Rows.Count, 3).End(xlUp).Row
If lFind > 3 Then .Range("B3").Resize(lFind, 3).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
End If
End With
End SubRe: Matching keywords with Product Description
So lets see if I have this correct.. On your WksOutput sheet Column F starting on Row 3, you want to put some names of some keywords down that column.
You then want to search through WksInput Sheet and on any match's in either Column B or Column D return those results in the order of Columns B thru D on the WksOutput correct?
Re: Matching keywords with Product Description
Not sure how big your sheet is so any chance you can attach a sample worksheet?
Re: Calculate hours of work across multiple shifts
Quote from pinkylocks;771243Hi Fuzz Head, the date format is (or should be!) DD/MM/YYYY HH:MM so 2nd June at 10pm to 3rd June at 6am.
Here you go, see if these formula's do what you wanted.
Re: Calculate hours of work across multiple shifts
Is there a reason why some of your Previous Night Shift Starts are almost a Month long. Example : 2/6/2016 22:00 to 3/6/2016 5:59
Re: Change format of a particular word in a spreadsheet
Nice approach StephenR!