Need a excel macro on to search and copy on the basis of multiple criteria - vba

Question

I am trying to create a VBA macro which will search the rows on the basis of the following criteria:
First it will look for a name specified in the macro in the name column.
If the name is found it will proceed to check the 'submitted' column and check whether the submitted date is between a weekly date. (like if the date is between 2/23/2015-2/27/2015).
If the date lies between the specified dates then the macro will group the activities based on their names and add the number of hours based on the values in the hours tab.
This whole data is finally to be copied and pasted into another worksheet in the same workbook.
So far I have only been able to get to searching for the names part and being a newbie to VBA macro I have absolutely no idea of how to proceed.
So far I have done pathetically since yesterday to come up with a solution. Please help. I am attaching my code, though I wonder if its of any use
Sub Demo()
Dim rngCell As Range
Dim lngLstRow As Long
Dim strFruit() As String
Dim intFruitMax As Integer
intFruitMax = 3
ReDim strFruit(1 To intFruitMax)
strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"
lngLstRow = ActiveSheet.UsedRange.Rows.Count
For Each rngCell In Range("J2:J" & lngLstRow)
For i = 1 To intFruitMax
If strFruit(i) = rngCell.Value Then
rngCell.EntireRow.Copy
Sheets("Inventory").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial xlPasteValues
Sheets("Sheet1").Select
End If
Next i
Next
End Sub

Answer 1

I believe the points below will allow you to progress although it cannot be a full answer because you do not give enough information for that. Warning: I do not explain my macros fully. Look up Help for the statements I use and try to work out why they have the effect they do. Come back with questions as necessary but the more you can work out for yourself, the more you will develop your VBA knowledge.
lngLstRow = ActiveSheet.UsedRange.Rows.Count
It is best to avoid ActiveSheet and UsedRange unless you know exactly what you are doing.
If you use the active worksheet, you are relying on the user having the correct worksheet active when they start the macro. You may one day want to allow the user to select which worksheet is the target for a macro but I doubt that is the case here. If possible be explicit. For example:
With Worksheets("New Data")
.Range("A1").Values = "Date"
End With
Above I explicit specify the worksheet I wish to use. It does not matter what worksheet is active when the user starts the macro. If I come back to the macro after six months, I do not have to remember which of the 20 worksheets it operates on.
Excel’s definition of UsedRange does not always mean what the programmer thinks its means. Do not use it until you have tried it out on a variety of test worksheets. In particular, try (1) formatting cells outside the range with values and (2) leaving the left columns and top rows unused. Try Debug.Print .UsedRange.Address. You will be surprised at some of the ranges you get.
Create a new workbook. Place values in E4, C7 and B10. Merge cells F12 and F13 and place a value in the merged area. It does not matter what those values are.
Copy this macro to a module and run it:
Option Explicit
Sub Test1()
Dim ColFinal As Long
Dim RowFinal As Long
Dim RowFinalC As Long
With Sheets("Sheet1")
RowFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
ColFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
RowFinalC = .Cells(Rows.Count, "C").End(xlUp).Row
End With
Debug.Print "ColFinal" = ColFinal
Debug.Print "RowFinal" = RowFinal
Debug.Print "RowFinalC" = RowFinalC
End Sub
The output will be:
ColFinal=5
RowFinal=12
RowFinalC=7
In most cases, Find is the best way of locating the last row and/or column of a worksheet. What:="*"means look for anything. Notice that I have different values for SearchOrder. It does not matter that the worksheet is not rectangular; the last row and the last column do not have to be the same cell.
However, there is no method of finding the last row or column that works in every situation. Find has not “seen” the merged cell when searching by column. (Warning, I am using an old version of Excel and this may have been fixed in your version.)
You want the last used cell in column J. My technique for finding the last row in column C may be the easiest technique for you.
Consider:
intFruitMax = 3
ReDim strFruit(1 To intFruitMax)
strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"
For i = 1 To intFruitMax
Next i
There is nothing wrong with your code but this macro shows a different approach that may be more convenient:
Sub Test2()
Dim Fruit() As Variant
Dim InxFruit As Long
Fruit = Array("A", "B", "C")
For InxFruit = LBound(Fruit) To UBound(Fruit)
Debug.Print Fruit(InxFruit)
Next
End Sub
It is becoming uncommon to have a three letter prefix specifying the type of a variable. As someone asked: “Is strFruit really more useful than Fruit?”. Avoid variable names like i. It probably does not matter with such a small macro but I have tried to decipher macros with a bunch of meaningless names and can assure you it is a nightmare. InxFruit says this is an index into array Fruit. I can look at macros I wrote years ago and immediately know what all the variables are.
LBound(Fruit) will always be zero if you use Array. Note also that Fruit has to be of type Variant. The advantage is that when you want to add fruits D and E, you just change to:
Fruit = Array("A", "B", "C", "D", "E")
If the name is found it will proceed to check the 'submitted' column and check whether the submitted date is between a weekly date. (like if the date is between 2/23/2015-2/27/2015).
Your technique for finding rows for interesting fruit is not the best technique but I think it is good enough. I am giving you enough to think about without discussing other approaches.
I am guessing you want to know if the date is between Monday and Friday of the current week.
Now() gives you the current date and time. The next macro shows how to calculate the Monday and Friday for any day of a week. If you chose to copy this technique, please document it properly for the benefit of the poor sod who has to update your macro in a year’s time. This macro is all clever arithmetic with functions and constants. I do not like clever code, unless it is properly documented, because it is usually the programmer showing off rather than solving the problem using the simplest method.
Sub Test3()
Dim Friday As Date
Dim InxDate As Long
Dim Monday As Date
Dim TestDates() As Variant
Dim Today As Date
Dim TodayDoW As Long
TestDates = Array(DateSerial(2015, 2, 22), DateSerial(2015, 2, 23), _
DateSerial(2015, 2, 24), DateSerial(2015, 2, 25), _
DateSerial(2015, 2, 26), DateSerial(2015, 2, 27), _
DateSerial(2015, 2, 28), Now())
For InxDate = 0 To UBound(TestDates)
Today = TestDates(InxDate)
TodayDoW = Weekday(Today)
Monday = DateSerial(Year(Today), Month(Today), Day(Today) + vbMonday - TodayDoW)
Friday = DateSerial(Year(Today), Month(Today), Day(Today) + vbFriday - TodayDoW)
Debug.Print "Today=" & Format(Today, "ddd d mmm yy") & _
" Monday=" & Format(Monday, "ddd d mmm yy") & _
" Friday=" & Format(Friday, "ddd d mmm yy")
Next
End Sub
Note that Excel holds dates as numbers so you can write If Monday <= TransDate And TransDate <= Friday Then.
Your technique for moving data from one worksheet to another is clumsy. This macro moves every row with “A”, “a”, “B”, “b”, “C” or “c” in column J from worksheet “Sheet2” to “Sheet3”. I believe you will agree the innermost loop in clearer than yours.
Sub Test4()
' I assume row 1 contains column headers and is not to be copied
' to the new worksheet. Constants are a good way of making such
' assumptions explicit and easy to change if for example to add
' a second header row
Const RowSht2DataFirst As Long = 2 ' This only applies to Sheet2
Const ColFruit As Long = 10 ' This applies to both sheets
Dim Fruit() As Variant
Dim FruitCrnt As String
Dim InxFruit As Long
Dim RowSht2Crnt As Long
Dim RowSht2Last As Long
Dim RowSht3Next As Long
Dim Wsht2 As Worksheet
Dim Wsht3 As Worksheet
' It takes VBA some time to evaluate Worksheets("Sheet2") and
' Worksheets("Sheet3"). This means it only has to do it once.
Set Wsht2 = Worksheets("Sheet2")
Set Wsht3 = Worksheets("Sheet3")
' BTW Please don't use the default names for a real workbook.
' It is so much easier to understand code with meaingful names
Fruit = Array("A", "B", "C")
With Wsht3
' Place new rows under any existing ones.
RowSht3Next = .Cells(Rows.Count, ColFruit).End(xlUp).Row + 1
End With
With Wsht2
RowSht2Last = .Cells(Rows.Count, ColFruit).End(xlUp).Row
For RowSht2Crnt = RowSht2DataFirst To RowSht2Last
FruitCrnt = UCase(.Cells(RowSht2Crnt, ColFruit).Value)
For InxFruit = LBound(Fruit) To UBound(Fruit)
If Fruit(InxFruit) = FruitCrnt Then
.Rows(RowSht2Crnt).Copy Destination:=Wsht3.Cells(RowSht3Next, 1)
RowSht3Next = RowSht3Next + 1
Exit For
End If ' Match on fruit
Next InxFruit
Next RowSht2Crnt
End With ' Wsht3
End Sub