Hello,
I've got a few columns of data in which 3 columns contain dates (in date format : dd/mm/yyyy) . Now, I want excel to seperate the entire row into another worksheet according to the YEAR in the 3 columns.
In cell ( 17,B) and (18,B), i type in the year for reference ( which i want excel to seperate the rows accoding to this year) . * The year is not in "absolute term" and so the macro needs to be capable to capture the value in cell (17,B) and (18,B).
For example::
If i typed in "2011" in cell ( 17,B) and "2012" in cell ( 18,B), i want excel to look through the 3 columns (I to K),copy the entire row if the years in ANY of the column ( I to K) contains year of 2011 and 2012 and paste them in sheet 2.
Please take a look at this reference file:
https://authentification.site/files/23779983/01.xls
In this file, i want to seperate the entire rows from column (E to M) in sheet 1 to sheet 2. And sheet 3 is approximately the final product i want. I need a VBA code for this....
Thanks! I couldn't find relavent information on google...
Sub details()
Dim i As Long
i = 2
5
If Cells(i, 1) = "" Then GoTo 10
i = i + 1: GoTo 5
10
N = i - 1
Sheets("Sheet4").Select
Range("H2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 3).Activate
ActiveCell.FormulaR1C1 = "C"
'apply the formula
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(AND(R2C19<>"""",OR(YEAR(RC[-5])=R2C19,YEAR(RC[-5])=R2C19,YEAR(RC[-3])=R2C19))),1,0)"
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.Interior.ColorIndex = xlNone
' in here, i use sorting instead of AUTOfilter. or else, the crieria for year "column S" would go missing.
Columns("A:K").Select
Selection.Sort Key1:=Range("K2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlStroke, DataOption1:=xlSortNormal
'because i used sorting, so i try to remove the range which contain "1" in column S
For i = 2 To N
If Cells(i, 11) <> 1 Then
ActiveSheet.Range(Cells(i, 1), Cells(i, 11)).Select
Selection.Delete Shift:=xlUp
End If
Next i
lMaxSupp = Cells(50, 19).End(xlUp).Row
For suppno = 2 To lMaxSupp
supName = Sheets("sheet4").Range("S" & suppno)
If supName <> "" Then
Sheets.Add
ActiveSheet.Name = supName
Sheets("Sheet4").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If
Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=11, Criteria1:="1"
Lastrow = Cells(300, 19).End(xlUp).Row
Rows("1:" & Lastrow).Copy
'error: subsript out or range.......
Sheets(supName).Range("A1").PasteSpecial
End If
Next
Sheets("Sheet4").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If
End Sub
---------------------------
I could not run though the whole macro as there is a "Subscript out of range" at Sheets(supName).Range("A1").PasteSpecial .....i tried to use filter as you said, but then the column which contain the YEAR would be gone after i applied it... what can i to solve the problem? MANY THANKS!
https://authentification.site/files/23882141/HOW.xls
Thanks! Please help!
Thank so much.. i have been struggling on this for a whole week!