Posts by DarrenSmith1981

There are month names in the 6th column and I need to filter between various months in this year.

I understand but I didn`t get a response from MrExcel so decided to try somewhere else as it`s fairly urgent.

Sorry if my crosspost upset people.

I also meant to alert you I had asked MrExcel forum but forgot to.

Sorry I see what you mean

Trying to filter by month

This filter is to filter the months (In column 6) on a sheet then copy the result over to another sheet but it won`t filter the first sheet?

Do I need to use a count x to count all filled-in cells in the column or do I need to use the date column (In Column 3) to filter?

Option Explicit
Public Sub PromptUserForInputMonths()






Dim strStart As String, strEnd As String, strPromptMessage As String
Dim wksData As Worksheet
Dim x As Integer
Dim Lastrow As Long
Dim Months As Object


strStart = InputBox("Please enter the Current JobNos.First Month")


Set wksData = ThisWorkbook.Worksheets("TGS JOB RECORD")
Lastrow = wksData.Range("A" & Rows.Count).End(xlUp).Row
Set Months = wksData.Range("F2:F" & Lastrow)


For x = 2 To 6


If Cells(x, 6).Value = strStart Then
strPromptMessage = "Oops! It looks like your entry is not a valid " & _
"date. Please retry with a valid date..."
MsgBox strPromptMessage
Exit Sub
End If
Next x


strEnd = InputBox("Please enter the  Current JobNos. Last Month")


For x = 2 To 6


If Cells(x, 6).Value = strEnd Then
strPromptMessage = "Oops! It looks like your entry is not a valid " & _
"date. Please retry with a valid date..."
MsgBox strPromptMessage
Exit Sub
End If
Next x
Call CreateSubsetWorksheet(strStart, strEnd)


End Sub


Public Sub CreateSubsetWorksheet(StartMonth As String, EndMonth As String)


TurnOff


ThisWorkbook.Worksheets("Current Jobs").Delete


Dim wksData As Worksheet, wksTarget As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
Dim rngFull As Range, rngResult As Range, rngTarget As Range, JobNotDone As Range




Set wksData = ThisWorkbook.Worksheets("TGS JOB RECORD")
lngDateCol = 6
Set JobNotDone = wksData.Range("A2").CurrentRegion




lngLastRow = LastOccupiedRowNum(wksData)
lngLastCol = LastOccupiedColNum(wksData)
With wksData
Set rngFull = wksData.Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
End With


wksData.AutoFilterMode = False


JobNotDone.AutoFilter field:=5, Criteria1:="="


With rngFull
.AutoFilter field:=lngDateCol, _
Criteria1:=">=" & StartMonth, Operator:=xlAnd, Criteria2:="<=" & EndMonth


Set rngResult = .SpecialCells(xlCellTypeVisible)


Set wksTarget = ThisWorkbook.Worksheets.Add
wksTarget.Name = "Current Jobs"
Set rngTarget = wksTarget.Cells(1, 1)
rngResult.Copy Destination:=rngTarget
wksTarget.Columns.AutoFit
Call Body_Name
End With






wksData.AutoFilterMode = False
If wksData.FilterMode = True Then
wksData.ShowAllData
End If






MsgBox "Data transferred!"




TurnOn


End Sub


Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long


If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(what:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function


Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(what:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function


Sub TurnOff()


Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False


End Sub
Sub TurnOn()


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

Sorry your right somehow it got deleted now it`s fine

Sorry seems to have stopped working

This line says Sub or Function not Defined?

outputRange.Cells(counter) = GetPartInfo(DataSet, cell.Value)

Sub GetPartInfoForRange(lookupRange As Range, outputRange As Range, DataSet As Object)

Dim cell As Range

Dim counter As Long

Dim ODict As Object

For Each cell In lookupRange.Cells

counter = counter + 1

outputRange.Cells(counter) = GetPartInfo(DataSet, cell.Value)

Next cell

End Sub

Very sorry now works fine sorry to waste your time.

The 5 referred to the 5th column in the Job Card Master Sheet I see what you mean.

Sorry data is back on the sheets

I changed the below. Not aware of any more changes

The data in PartsList Range E F is 1 & 2 columns in the range is this right

GetPartInfoForRange area.Columns(1), area.Columns(2), ODict

https://www.dropbox.com/t/9yHWkVfEbNQmw3HZ

Here you go

https://www.dropbox.com/t/xKIg0O95fsOYLVbV

Terribly sorry but after I changed my Data to match still no luck

This "Set ODict = GetDictionary(matchRange, 1, 2)" seems to be the issue it seems to say nothing.

Should it be filling in with the cell values from the parts List?

I`ve added your code above but still no luck?

On the user form if you go to the Reset_Drawing_Numbers combo box it`s there

Here you go

https://www.dropbox.com/t/rMAUBw9GAuATVOBj

Mt

I`ve taken it away but it`s still not working. Nothing happens.

Would it help if I sent you my workbook

You're on the right track but?

This part of the code below, wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value) says "method range of object worksheet Failed?"

Sub GetPartInfoForRange(lookupRange As Range, outputRange As Range, DataSet As Object)

Dim cell As Range

Dim counter As Long

Dim ODict As Object

Dim wsDest As Worksheet

Dim i As Integer

Set wsDest = ThisWorkbook.Worksheets("Job Card Master")

For Each cell In lookupRange.Cells

counter = counter + 1

outputRange.Cells(counter) = GetPartInfo(DataSet, cell.Value)

Next cell

wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value)

End Sub

The choice is from the cmb control

The ranges are pages 1 to 5

The ranges need the Drawing numbers filled in from the Parts List sheet but not the 4 rows in between the pages.

These are the ranges not part of this code but shows what I mean

Select Case cmb.Value

Case ("Break Lines 1 Page Job Card")

colorAbove ws.Range("A13:Q" & LastRow)

Case ("Break Lines 2 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q" & LastRow)

Case ("Break Lines 3 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q122")

colorAbove ws.Range("A127:Q" & LastRow)

Case ("Break Lines 4 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q122")

colorAbove ws.Range("A127:Q183")

colorAbove ws.Range("A188:Q" & LastRow)

Case ("Break Lines 5 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q122")

colorAbove ws.Range("A127:Q183")

colorAbove ws.Range("A188:Q244")

colorAbove ws.Range("A249:Q" & LastRow)

End Select

What do you mean by Clarify. I am trying to make it clear?

Sorry yes, should have been clearer. But it does require using ranges

That code filled in all cells in column B but I need it to fill in the specified Ranges.

There are pages 1-5 which there are 4 rows between each page